From rtoy at common-lisp.net Fri Aug 24 01:12:18 2007 From: rtoy at common-lisp.net (rtoy) Date: Thu, 23 Aug 2007 21:12:18 -0400 (EDT) Subject: [oct-cvs] CVS oct Message-ID: <20070824011218.AB30244065@common-lisp.net> Update of /project/oct/cvsroot/oct In directory clnet:/tmp/cvs-serv346 Modified Files: oct.system Log Message: Changed system from qd to oct. --- /project/oct/cvsroot/oct/oct.system 2007/08/22 16:54:45 1.18 +++ /project/oct/cvsroot/oct/oct.system 2007/08/24 01:12:18 1.19 @@ -21,7 +21,7 @@ (eval-when (:load-toplevel :compile-toplevel :execute) (setf ext:*inline-expansion-limit* 1600)) -(mk:defsystem qd +(mk:defsystem oct :source-pathname (make-pathname :directory (pathname-directory *load-pathname*)) :components ((:file "qd-package") @@ -47,15 +47,15 @@ )) -(mk:defsystem qd-extras +(mk:defsystem oct-extras :source-pathname (make-pathname :directory (pathname-directory *load-pathname*)) - :depends-on ("qd") + :depends-on ("oct") :components ((:file "qd-extra"))) -(mk:defsystem qd-test +(mk:defsystem oct-test :source-pathname (make-pathname :directory (pathname-directory *load-pathname*)) - :depends-on ("qd" "qd-extras") + :depends-on ("oct" "oct-extras") :components ((:file "qd-test") (:file "tests") From rtoy at common-lisp.net Fri Aug 24 20:35:46 2007 From: rtoy at common-lisp.net (rtoy) Date: Fri, 24 Aug 2007 16:35:46 -0400 (EDT) Subject: [oct-cvs] CVS oct Message-ID: <20070824203546.EBC292B129@common-lisp.net> Update of /project/oct/cvsroot/oct In directory clnet:/tmp/cvs-serv9595 Modified Files: qd-package.lisp Log Message: Add OCT as package nickname. --- /project/oct/cvsroot/oct/qd-package.lisp 2007/06/12 14:57:01 1.29 +++ /project/oct/cvsroot/oct/qd-package.lisp 2007/08/24 20:35:46 1.30 @@ -75,7 +75,7 @@ (defpackage #:quad-double (:use #:cl #:quad-double-internal) - (:nicknames #:qd) + (:nicknames #:oct #:qd) (:shadow #:+ #:- #:* From rtoy at common-lisp.net Fri Aug 24 20:50:45 2007 From: rtoy at common-lisp.net (rtoy) Date: Fri, 24 Aug 2007 16:50:45 -0400 (EDT) Subject: [oct-cvs] CVS CVSROOT Message-ID: <20070824205045.685262D07D@common-lisp.net> Update of /project/oct/cvsroot/CVSROOT In directory clnet:/tmp/cvs-serv12318 Modified Files: loginfo Log Message: Use our own commit so the subject line has more info about the commit. --- /project/oct/cvsroot/CVSROOT/loginfo 2007/08/22 12:25:01 1.2 +++ /project/oct/cvsroot/CVSROOT/loginfo 2007/08/24 20:50:45 1.3 @@ -29,4 +29,5 @@ #DEFAULT (echo ""; id; echo %s; date; cat) >> $CVSROOT/CVSROOT/commitlog # or #DEFAULT (echo ""; id; echo %{sVv}; date; cat) >> $CVSROOT/CVSROOT/commitlog -DEFAULT cvs-mailcommit --mailto oct-cvs at common-lisp.net --diff --full --root %r --dir %p %{sVv} +#DEFAULT cvs-mailcommit --mailto oct-cvs at common-lisp.net --diff --full --root %r --dir %p %{sVv} +DEFAULT /project/oct/cvsroot/CVSROOT/cvs-mailcommit --mailto cmucl-commit at cons.org --diff --full --root %r --dir %p %{sVv} From rtoy at common-lisp.net Fri Aug 24 21:45:16 2007 From: rtoy at common-lisp.net (rtoy) Date: Fri, 24 Aug 2007 17:45:16 -0400 (EDT) Subject: [oct-cvs] Oct commit: oct qd-const.lisp qd-io.lisp qd-methods.lisp Message-ID: <20070824214516.A553044065@common-lisp.net> Update of /project/oct/cvsroot/oct In directory clnet:/tmp/cvs-serv20277 Modified Files: qd-const.lisp qd-io.lisp qd-methods.lisp Log Message: qd-io.lisp: o Get rid of the #q reader that returns an internal %qd-real. qd-methods.lisp: o QPHASE was returning the wrong kind of object for positive values. o Replace use of #q0 with the construction of a qd-real 0. qd-const.lisp: o Replace all uses of #q with #.(qd-from-string ...). --- /project/oct/cvsroot/oct/qd-const.lisp 2007/05/31 02:47:37 1.13 +++ /project/oct/cvsroot/oct/qd-const.lisp 2007/08/24 21:45:16 1.14 @@ -2201,69 +2201,69 @@ +qd-pi/4+ ;; Do we need to make these values more accurate? (The ;; reader has quite a bit of roundoff.) - #q0.46364760900080611621425623146121440202853705428612026381093308872018q0 - #q0.24497866312686415417208248121127581091414409838118406712737591466738q0 - #q0.12435499454676143503135484916387102557317019176980408991511411911572q0 - #q0.062418809995957348473979112985505113606273887797499194607527816898697q0 - #q0.031239833430268276253711744892490977032495663725400040255315586255793q0 - #q0.0156237286204768308028015212565703189111141398009054178814105073966645q0 - #q0.0078123410601011112964633918421992816212228117250147235574539022483893q0 - #q0.003906230131966971827628665311424387140357490115202856215213095149011q0 - #q0.00195312251647881868512148262507671393161074677723351033905753396043094q0 - #q9.7656218955931943040343019971729085163419701581008759004900725226773q-4 - #q4.8828121119489827546923962564484866619236113313500303710940335348752q-4 - #q2.4414062014936176401672294325965998621241779097061761180790046091019q-4 - #q1.22070311893670204239058646117956300930829409015787498451939837846645q-4 - #q6.1035156174208775021662569173829153785143536833346179337671134316588q-5 - #q3.0517578115526096861825953438536019750949675119437837531021156883611q-5 - #q1.5258789061315762107231935812697885137429238144575874846241186407446q-5 - #q7.6293945311019702633884823401050905863507439184680771577638306965336q-6 - #q3.8146972656064962829230756163729937228052573039688663101874392503939q-6 - #q1.9073486328101870353653693059172441687143421654501533666700577234671q-6 - #q9.53674316405960879420670689923112390019634124498790160133611802076q-7 - #q4.7683715820308885992758382144924707587049404378664196740053215887142q-7 - #q2.3841857910155798249094797721893269783096898769063155913766911372218q-7 - #q1.19209289550780685311368497137922112645967587664586735576738225215437q-7 - #q5.9604644775390554413921062141788874250030195782366297314294565710003q-8 - #q2.9802322387695303676740132767709503349043907067445107249258477840843q-8 - #q1.4901161193847655147092516595963247108248930025964720012170057805491q-8 - #q7.4505805969238279871365645744953921132066925545665870075947601416172q-9 - #q3.725290298461914045267070571811923583671948328737040524231998269239q-9 - #q1.8626451492309570290958838214764904345065282835738863513491050124951q-9 - #q9.3132257461547851535573547768456130389292649614929067394376854242196q-10 - #q4.6566128730773925777884193471057016297347863891561617421323492554414q-10 - #q2.32830643653869628902042741838821270371274293204981860525486662280605q-10 - #q1.16415321826934814452599092729852658796396457380014290026584979170883q-10 - #q5.8207660913467407226496761591231582349549156257795272423976206167147q-11 - #q2.9103830456733703613273032698903947793693632003639830495829934525029q-11 - #q1.4551915228366851806639597837362993474211703608936710732067270213307q-11 - #q7.2759576141834259033201841046703741842764629388821429640111752890838q-12 - #q3.6379788070917129516601402005837967730345578669779258118296083646486q-12 - #q1.81898940354585647583007611882297459662931973336029253714520765350336q-12 - #q9.094947017729282379150388117278718245786649666696631862264792881855q-13 - #q4.5474735088646411895751949990348397807233312083369623012466392138249q-13 - #q2.2737367544323205947875976170668549725904164010421166413578155299654q-13 - #q1.1368683772161602973937988232271068715738020501302644662229139921281q-13 - #q5.6843418860808014869689941345026335894672525626628305471702634435609q-14 - #q2.8421709430404007434844970695472041986834065703328538172835210852389q-14 - #q1.42108547152020037174224853506058802483542582129160672712566632799217q-14 - #q7.1054273576010018587112426756616725310442822766145084088962160950957q-15 - #q3.5527136788005009293556213378756778163805352845768135511116874239215q-15 - #q1.7763568394002504646778106689434441020475669105721016938889503158663q-15 - #q8.881784197001252323389053344724227002559458638215127117361184578544q-16 - #q4.440892098500626161694526672362989312819932329776890889670147968684q-16 - #q2.22044604925031308084726333618160413285249154122211136120876849284695q-16 - #q1.11022302462515654042363166809081575098156144265276392015109606150467q-16 - #q5.5511151231257827021181583404540958606019518033159549001888700768492q-17 - #q2.7755575615628913510590791702270500685127439754144943625236087596052q-17 - #q1.3877787807814456755295395851135253015328429969268117953154510949506q-17 - #q6.9388939039072283776476979255676268417598037461585147441443138686883q-18 - #q3.4694469519536141888238489627838134626418504682698143430180392335861q-18 - #q1.7347234759768070944119244813919067365411688085337267928772549041983q-18 - #q8.673617379884035472059622406959533689231148510667158491096568630248q-19 - #q4.336808689942017736029811203479766845431237313833394811387071078781q-19 - #q2.16840434497100886801490560173988342281757653922917435142338388484765q-19 - #q1.08420217248550443400745280086994171142153300490364679392792298560597q-19 + #.(qd-from-string "0.46364760900080611621425623146121440202853705428612026381093308872018q0") + #.(qd-from-string "0.24497866312686415417208248121127581091414409838118406712737591466738q0") + #.(qd-from-string "0.12435499454676143503135484916387102557317019176980408991511411911572q0") + #.(qd-from-string "0.062418809995957348473979112985505113606273887797499194607527816898697q0") + #.(qd-from-string "0.031239833430268276253711744892490977032495663725400040255315586255793q0") + #.(qd-from-string "0.0156237286204768308028015212565703189111141398009054178814105073966645q0") + #.(qd-from-string "0.0078123410601011112964633918421992816212228117250147235574539022483893q0") + #.(qd-from-string "0.003906230131966971827628665311424387140357490115202856215213095149011q0") + #.(qd-from-string "0.00195312251647881868512148262507671393161074677723351033905753396043094q0") + #.(qd-from-string "9.7656218955931943040343019971729085163419701581008759004900725226773q-4") + #.(qd-from-string "4.8828121119489827546923962564484866619236113313500303710940335348752q-4") + #.(qd-from-string "2.4414062014936176401672294325965998621241779097061761180790046091019q-4") + #.(qd-from-string "1.22070311893670204239058646117956300930829409015787498451939837846645q-4") + #.(qd-from-string "6.1035156174208775021662569173829153785143536833346179337671134316588q-5") + #.(qd-from-string "3.0517578115526096861825953438536019750949675119437837531021156883611q-5") + #.(qd-from-string "1.5258789061315762107231935812697885137429238144575874846241186407446q-5") + #.(qd-from-string "7.6293945311019702633884823401050905863507439184680771577638306965336q-6") + #.(qd-from-string "3.8146972656064962829230756163729937228052573039688663101874392503939q-6") + #.(qd-from-string "1.9073486328101870353653693059172441687143421654501533666700577234671q-6") + #.(qd-from-string "9.53674316405960879420670689923112390019634124498790160133611802076q-7") + #.(qd-from-string "4.7683715820308885992758382144924707587049404378664196740053215887142q-7") + #.(qd-from-string "2.3841857910155798249094797721893269783096898769063155913766911372218q-7") + #.(qd-from-string "1.19209289550780685311368497137922112645967587664586735576738225215437q-7") + #.(qd-from-string "5.9604644775390554413921062141788874250030195782366297314294565710003q-8") + #.(qd-from-string "2.9802322387695303676740132767709503349043907067445107249258477840843q-8") + #.(qd-from-string "1.4901161193847655147092516595963247108248930025964720012170057805491q-8") + #.(qd-from-string "7.4505805969238279871365645744953921132066925545665870075947601416172q-9") + #.(qd-from-string "3.725290298461914045267070571811923583671948328737040524231998269239q-9") + #.(qd-from-string "1.8626451492309570290958838214764904345065282835738863513491050124951q-9") + #.(qd-from-string "9.3132257461547851535573547768456130389292649614929067394376854242196q-10") + #.(qd-from-string "4.6566128730773925777884193471057016297347863891561617421323492554414q-10") + #.(qd-from-string "2.32830643653869628902042741838821270371274293204981860525486662280605q-10") + #.(qd-from-string "1.16415321826934814452599092729852658796396457380014290026584979170883q-10") + #.(qd-from-string "5.8207660913467407226496761591231582349549156257795272423976206167147q-11") + #.(qd-from-string "2.9103830456733703613273032698903947793693632003639830495829934525029q-11") + #.(qd-from-string "1.4551915228366851806639597837362993474211703608936710732067270213307q-11") + #.(qd-from-string "7.2759576141834259033201841046703741842764629388821429640111752890838q-12") + #.(qd-from-string "3.6379788070917129516601402005837967730345578669779258118296083646486q-12") + #.(qd-from-string "1.81898940354585647583007611882297459662931973336029253714520765350336q-12") + #.(qd-from-string "9.094947017729282379150388117278718245786649666696631862264792881855q-13") + #.(qd-from-string "4.5474735088646411895751949990348397807233312083369623012466392138249q-13") + #.(qd-from-string "2.2737367544323205947875976170668549725904164010421166413578155299654q-13") + #.(qd-from-string "1.1368683772161602973937988232271068715738020501302644662229139921281q-13") + #.(qd-from-string "5.6843418860808014869689941345026335894672525626628305471702634435609q-14") + #.(qd-from-string "2.8421709430404007434844970695472041986834065703328538172835210852389q-14") + #.(qd-from-string "1.42108547152020037174224853506058802483542582129160672712566632799217q-14") + #.(qd-from-string "7.1054273576010018587112426756616725310442822766145084088962160950957q-15") + #.(qd-from-string "3.5527136788005009293556213378756778163805352845768135511116874239215q-15") + #.(qd-from-string "1.7763568394002504646778106689434441020475669105721016938889503158663q-15") + #.(qd-from-string "8.881784197001252323389053344724227002559458638215127117361184578544q-16") + #.(qd-from-string "4.440892098500626161694526672362989312819932329776890889670147968684q-16") + #.(qd-from-string "2.22044604925031308084726333618160413285249154122211136120876849284695q-16") + #.(qd-from-string "1.11022302462515654042363166809081575098156144265276392015109606150467q-16") + #.(qd-from-string "5.5511151231257827021181583404540958606019518033159549001888700768492q-17") + #.(qd-from-string "2.7755575615628913510590791702270500685127439754144943625236087596052q-17") + #.(qd-from-string "1.3877787807814456755295395851135253015328429969268117953154510949506q-17") + #.(qd-from-string "6.9388939039072283776476979255676268417598037461585147441443138686883q-18") + #.(qd-from-string "3.4694469519536141888238489627838134626418504682698143430180392335861q-18") + #.(qd-from-string "1.7347234759768070944119244813919067365411688085337267928772549041983q-18") + #.(qd-from-string "8.673617379884035472059622406959533689231148510667158491096568630248q-19") + #.(qd-from-string "4.336808689942017736029811203479766845431237313833394811387071078781q-19") + #.(qd-from-string "2.16840434497100886801490560173988342281757653922917435142338388484765q-19") + #.(qd-from-string "1.08420217248550443400745280086994171142153300490364679392792298560597q-19") )) "Table of atan(2^(-k)) for k = 1 to 64. But the first three entries are 1") @@ -2553,7 +2553,7 @@ "Table of (2^(-k)) for k = -2 to 64. But the first three entries are 1") (defconstant +cordic-scale+ - #q0.065865828601599636584870082133151126045971796871364763285694473524426q0) + #.(qd-from-string "0.065865828601599636584870082133151126045971796871364763285694473524426q0")) (defun dump-qd (qd) (flet ((dump-d (d) --- /project/oct/cvsroot/oct/qd-io.lisp 2007/06/13 16:34:52 1.11 +++ /project/oct/cvsroot/oct/qd-io.lisp 2007/08/24 21:45:16 1.12 @@ -442,5 +442,6 @@ (cl::with-input-from-string (s string) (read-qd s))) +#+nil (set-dispatch-macro-character #\# #\Q #'qd-reader) --- /project/oct/cvsroot/oct/qd-methods.lisp 2007/08/23 17:15:06 1.43 +++ /project/oct/cvsroot/oct/qd-methods.lisp 2007/08/24 21:45:16 1.44 @@ -761,7 +761,7 @@ (defmethod qphase ((x qd-real)) (if (minusp x) (- +pi+) - #q0)) + (make-instance 'qd-real :value (make-qd-d 0d0)))) (declaim (inline phase)) (defun phase (x) From rtoy at common-lisp.net Sat Aug 25 02:08:04 2007 From: rtoy at common-lisp.net (rtoy) Date: Fri, 24 Aug 2007 22:08:04 -0400 (EDT) Subject: [oct-cvs] Oct commit: oct qd-methods.lisp qd-package.lisp Message-ID: <20070825020804.B47F32E1D4@common-lisp.net> Update of /project/oct/cvsroot/oct In directory clnet:/tmp/cvs-serv27460 Modified Files: qd-methods.lisp qd-package.lisp Log Message: qd-package.lisp: o Shadow CL:COERCE and export QD:COERCE qd-methods.lisp: o Define methods for COERCE so we can use COERCE with QD-REAL and QD-COMPLEX. --- /project/oct/cvsroot/oct/qd-methods.lisp 2007/08/24 21:45:16 1.44 +++ /project/oct/cvsroot/oct/qd-methods.lisp 2007/08/25 02:08:04 1.45 @@ -775,6 +775,23 @@ (if (plusp number) 1 -1) (/ number (abs number))))) +(defmethod coerce ((obj t) (type t)) + (cl:coerce obj type)) + +(defmethod coerce ((number cl:real) (type (eql 'qd-real))) + (float number #q0)) + +(defmethod coerce ((number qd-real) (type (eql 'qd-real))) + number) + +(defmethod coerce ((number cl:number) (type (eql 'qd-complex))) + (complex (float (realpart number) #q0) + (float (imagpart number) #q0))) + +(defmethod coerce ((number qd-complex) (type (eql qd-complex))) + number) + + (define-compiler-macro + (&whole form &rest args) (if (null args) 0 --- /project/oct/cvsroot/oct/qd-package.lisp 2007/08/24 20:35:46 1.30 +++ /project/oct/cvsroot/oct/qd-package.lisp 2007/08/25 02:08:04 1.31 @@ -131,6 +131,7 @@ #:cis #:phase #:signum + #:coerce ) (:export #:+ #:- @@ -187,6 +188,7 @@ #:cis #:phase #:signum + #:coerce ) ;; Constants (:export #:+pi+) From rtoy at common-lisp.net Sat Aug 25 16:16:53 2007 From: rtoy at common-lisp.net (rtoy) Date: Sat, 25 Aug 2007 12:16:53 -0400 (EDT) Subject: [oct-cvs] Oct commit: oct .cvsignore Message-ID: <20070825161653.8DA945F062@common-lisp.net> Update of /project/oct/cvsroot/oct In directory clnet:/tmp/cvs-serv22578 Added Files: .cvsignore Log Message: Initial revision. --- /project/oct/cvsroot/oct/.cvsignore 2007/08/25 16:16:53 NONE +++ /project/oct/cvsroot/oct/.cvsignore 2007/08/25 16:16:53 1.1 *.ppcf *.err From rtoy at common-lisp.net Sat Aug 25 17:08:21 2007 From: rtoy at common-lisp.net (rtoy) Date: Sat, 25 Aug 2007 13:08:21 -0400 (EDT) Subject: [oct-cvs] Oct commit: oct LICENSE Message-ID: <20070825170821.8B7F155354@common-lisp.net> Update of /project/oct/cvsroot/oct In directory clnet:/tmp/cvs-serv330 Added Files: LICENSE Log Message: Initial revision. --- /project/oct/cvsroot/oct/LICENSE 2007/08/25 17:08:21 NONE +++ /project/oct/cvsroot/oct/LICENSE 2007/08/25 17:08:21 1.1 Copyright (c) 2007 Raymond Toy Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. From rtoy at common-lisp.net Sat Aug 25 17:08:49 2007 From: rtoy at common-lisp.net (rtoy) Date: Sat, 25 Aug 2007 13:08:49 -0400 (EDT) Subject: [oct-cvs] Oct commit: oct oct.system qd-class.lisp qd-complex.lisp qd-const.lisp qd-dd.lisp qd-extra.lisp qd-format.lisp qd-fun.lisp qd-io.lisp qd-methods.lisp qd-package.lisp qd-rep.lisp qd.lisp Message-ID: <20070825170849.2C0465F05D@common-lisp.net> Update of /project/oct/cvsroot/oct In directory clnet:/tmp/cvs-serv356 Modified Files: oct.system qd-class.lisp qd-complex.lisp qd-const.lisp qd-dd.lisp qd-extra.lisp qd-format.lisp qd-fun.lisp qd-io.lisp qd-methods.lisp qd-package.lisp qd-rep.lisp qd.lisp Log Message: Add license information (MIT). --- /project/oct/cvsroot/oct/oct.system 2007/08/24 01:12:18 1.19 +++ /project/oct/cvsroot/oct/oct.system 2007/08/25 17:08:48 1.20 @@ -1,4 +1,27 @@ -;;; -*- Mode: lisp -*- +;;;; -*- Mode: lisp -*- +;;;; +;;;; Copyright (c) 2007 Raymond Toy +;;;; +;;;; Permission is hereby granted, free of charge, to any person +;;;; obtaining a copy of this software and associated documentation +;;;; files (the "Software"), to deal in the Software without +;;;; restriction, including without limitation the rights to use, +;;;; copy, modify, merge, publish, distribute, sublicense, and/or sell +;;;; copies of the Software, and to permit persons to whom the +;;;; Software is furnished to do so, subject to the following +;;;; conditions: +;;;; +;;;; The above copyright notice and this permission notice shall be +;;;; included in all copies or substantial portions of the Software. +;;;; +;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES +;;;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT +;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, +;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +;;;; OTHER DEALINGS IN THE SOFTWARE. ;; If you want all core functions to be inline (like the C++ code ;; does), add :qd-inline to *features* by enabling the following line. --- /project/oct/cvsroot/oct/qd-class.lisp 2007/06/15 16:35:50 1.19 +++ /project/oct/cvsroot/oct/qd-class.lisp 2007/08/25 17:08:48 1.20 @@ -1,3 +1,28 @@ +;;;; -*- Mode: lisp -*- +;;;; +;;;; Copyright (c) 2007 Raymond Toy +;;;; +;;;; Permission is hereby granted, free of charge, to any person +;;;; obtaining a copy of this software and associated documentation +;;;; files (the "Software"), to deal in the Software without +;;;; restriction, including without limitation the rights to use, +;;;; copy, modify, merge, publish, distribute, sublicense, and/or sell +;;;; copies of the Software, and to permit persons to whom the +;;;; Software is furnished to do so, subject to the following +;;;; conditions: +;;;; +;;;; The above copyright notice and this permission notice shall be +;;;; included in all copies or substantial portions of the Software. +;;;; +;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES +;;;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT +;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, +;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +;;;; OTHER DEALINGS IN THE SOFTWARE. + (in-package "QD") (define-symbol-macro * cl:*) --- /project/oct/cvsroot/oct/qd-complex.lisp 2007/08/23 18:42:28 1.26 +++ /project/oct/cvsroot/oct/qd-complex.lisp 2007/08/25 17:08:48 1.27 @@ -1,3 +1,28 @@ +;;;; -*- Mode: lisp -*- +;;;; +;;;; Copyright (c) 2007 Raymond Toy +;;;; +;;;; Permission is hereby granted, free of charge, to any person +;;;; obtaining a copy of this software and associated documentation +;;;; files (the "Software"), to deal in the Software without +;;;; restriction, including without limitation the rights to use, +;;;; copy, modify, merge, publish, distribute, sublicense, and/or sell +;;;; copies of the Software, and to permit persons to whom the +;;;; Software is furnished to do so, subject to the following +;;;; conditions: +;;;; +;;;; The above copyright notice and this permission notice shall be +;;;; included in all copies or substantial portions of the Software. +;;;; +;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES +;;;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT +;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, +;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +;;;; OTHER DEALINGS IN THE SOFTWARE. + ;; Most of this code taken from CMUCL and slightly modified to support ;; QD-COMPLEX. --- /project/oct/cvsroot/oct/qd-const.lisp 2007/08/24 21:45:16 1.14 +++ /project/oct/cvsroot/oct/qd-const.lisp 2007/08/25 17:08:48 1.15 @@ -1,4 +1,27 @@ -;;; -*- Mode: lisp -*- +;;;; -*- Mode: lisp -*- +;;;; +;;;; Copyright (c) 2007 Raymond Toy +;;;; +;;;; Permission is hereby granted, free of charge, to any person +;;;; obtaining a copy of this software and associated documentation +;;;; files (the "Software"), to deal in the Software without +;;;; restriction, including without limitation the rights to use, +;;;; copy, modify, merge, publish, distribute, sublicense, and/or sell +;;;; copies of the Software, and to permit persons to whom the +;;;; Software is furnished to do so, subject to the following +;;;; conditions: +;;;; +;;;; The above copyright notice and this permission notice shall be +;;;; included in all copies or substantial portions of the Software. +;;;; +;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES +;;;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT +;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, +;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +;;;; OTHER DEALINGS IN THE SOFTWARE. (in-package "QDI") --- /project/oct/cvsroot/oct/qd-dd.lisp 2007/06/02 12:20:25 1.3 +++ /project/oct/cvsroot/oct/qd-dd.lisp 2007/08/25 17:08:48 1.4 @@ -1,4 +1,27 @@ -;;; -*- Mode: lisp -*- +;;;; -*- Mode: lisp -*- +;;;; +;;;; Copyright (c) 2007 Raymond Toy +;;;; +;;;; Permission is hereby granted, free of charge, to any person +;;;; obtaining a copy of this software and associated documentation +;;;; files (the "Software"), to deal in the Software without +;;;; restriction, including without limitation the rights to use, +;;;; copy, modify, merge, publish, distribute, sublicense, and/or sell +;;;; copies of the Software, and to permit persons to whom the +;;;; Software is furnished to do so, subject to the following +;;;; conditions: +;;;; +;;;; The above copyright notice and this permission notice shall be +;;;; included in all copies or substantial portions of the Software. +;;;; +;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES +;;;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT +;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, +;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +;;;; OTHER DEALINGS IN THE SOFTWARE. (in-package #:qdi) --- /project/oct/cvsroot/oct/qd-extra.lisp 2007/06/14 20:14:33 1.1 +++ /project/oct/cvsroot/oct/qd-extra.lisp 2007/08/25 17:08:48 1.2 @@ -1,4 +1,27 @@ ;;;; -*- Mode: lisp -*- +;;;; +;;;; Copyright (c) 2007 Raymond Toy +;;;; +;;;; Permission is hereby granted, free of charge, to any person +;;;; obtaining a copy of this software and associated documentation +;;;; files (the "Software"), to deal in the Software without +;;;; restriction, including without limitation the rights to use, +;;;; copy, modify, merge, publish, distribute, sublicense, and/or sell +;;;; copies of the Software, and to permit persons to whom the +;;;; Software is furnished to do so, subject to the following +;;;; conditions: +;;;; +;;;; The above copyright notice and this permission notice shall be +;;;; included in all copies or substantial portions of the Software. +;;;; +;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES +;;;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT +;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, +;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +;;;; OTHER DEALINGS IN THE SOFTWARE. ;;; This file contains various possible implementations of some of the ;;; core routines. These were experiments on faster and/or more --- /project/oct/cvsroot/oct/qd-format.lisp 2007/05/31 02:45:48 1.3 +++ /project/oct/cvsroot/oct/qd-format.lisp 2007/08/25 17:08:48 1.4 @@ -1,3 +1,28 @@ +;;;; -*- Mode: lisp -*- +;;;; +;;;; Copyright (c) 2007 Raymond Toy +;;;; +;;;; Permission is hereby granted, free of charge, to any person +;;;; obtaining a copy of this software and associated documentation +;;;; files (the "Software"), to deal in the Software without +;;;; restriction, including without limitation the rights to use, +;;;; copy, modify, merge, publish, distribute, sublicense, and/or sell +;;;; copies of the Software, and to permit persons to whom the +;;;; Software is furnished to do so, subject to the following +;;;; conditions: +;;;; +;;;; The above copyright notice and this permission notice shall be +;;;; included in all copies or substantial portions of the Software. +;;;; +;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES +;;;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT +;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, +;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +;;;; OTHER DEALINGS IN THE SOFTWARE. + (in-package "QD") (defun qd-scale-exponent (original-x) --- /project/oct/cvsroot/oct/qd-fun.lisp 2007/06/14 20:14:33 1.78 +++ /project/oct/cvsroot/oct/qd-fun.lisp 2007/08/25 17:08:48 1.79 @@ -1,4 +1,27 @@ ;;;; -*- Mode: lisp -*- +;;;; +;;;; Copyright (c) 2007 Raymond Toy +;;;; +;;;; Permission is hereby granted, free of charge, to any person +;;;; obtaining a copy of this software and associated documentation +;;;; files (the "Software"), to deal in the Software without +;;;; restriction, including without limitation the rights to use, +;;;; copy, modify, merge, publish, distribute, sublicense, and/or sell +;;;; copies of the Software, and to permit persons to whom the +;;;; Software is furnished to do so, subject to the following +;;;; conditions: +;;;; +;;;; The above copyright notice and this permission notice shall be +;;;; included in all copies or substantial portions of the Software. +;;;; +;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES +;;;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT +;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, +;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +;;;; OTHER DEALINGS IN THE SOFTWARE. ;;; Basic special functions operating on %quad-double numbers. This ;;; includes sqrt, rounding to the nearest integer, floor, exp, log, --- /project/oct/cvsroot/oct/qd-io.lisp 2007/08/24 21:45:16 1.12 +++ /project/oct/cvsroot/oct/qd-io.lisp 2007/08/25 17:08:48 1.13 @@ -1,3 +1,28 @@ +;;;; -*- Mode: lisp -*- +;;;; +;;;; Copyright (c) 2007 Raymond Toy +;;;; +;;;; Permission is hereby granted, free of charge, to any person +;;;; obtaining a copy of this software and associated documentation +;;;; files (the "Software"), to deal in the Software without +;;;; restriction, including without limitation the rights to use, +;;;; copy, modify, merge, publish, distribute, sublicense, and/or sell +;;;; copies of the Software, and to permit persons to whom the +;;;; Software is furnished to do so, subject to the following +;;;; conditions: +;;;; +;;;; The above copyright notice and this permission notice shall be +;;;; included in all copies or substantial portions of the Software. +;;;; +;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES +;;;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT +;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, +;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +;;;; OTHER DEALINGS IN THE SOFTWARE. + (in-package "QDI") ;; Smallest exponent for a double-float. --- /project/oct/cvsroot/oct/qd-methods.lisp 2007/08/25 02:08:04 1.45 +++ /project/oct/cvsroot/oct/qd-methods.lisp 2007/08/25 17:08:48 1.46 @@ -1,3 +1,28 @@ +;;;; -*- Mode: lisp -*- +;;;; +;;;; Copyright (c) 2007 Raymond Toy +;;;; +;;;; Permission is hereby granted, free of charge, to any person +;;;; obtaining a copy of this software and associated documentation +;;;; files (the "Software"), to deal in the Software without +;;;; restriction, including without limitation the rights to use, +;;;; copy, modify, merge, publish, distribute, sublicense, and/or sell +;;;; copies of the Software, and to permit persons to whom the +;;;; Software is furnished to do so, subject to the following +;;;; conditions: +;;;; +;;;; The above copyright notice and this permission notice shall be +;;;; included in all copies or substantial portions of the Software. +;;;; +;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES +;;;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT +;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, +;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +;;;; OTHER DEALINGS IN THE SOFTWARE. + (in-package "QD") (defconstant +pi+ --- /project/oct/cvsroot/oct/qd-package.lisp 2007/08/25 02:08:04 1.31 +++ /project/oct/cvsroot/oct/qd-package.lisp 2007/08/25 17:08:48 1.32 @@ -1,4 +1,27 @@ -;;; -*- Mode: lisp -*- +;;;; -*- Mode: lisp -*- +;;;; +;;;; Copyright (c) 2007 Raymond Toy +;;;; +;;;; Permission is hereby granted, free of charge, to any person +;;;; obtaining a copy of this software and associated documentation +;;;; files (the "Software"), to deal in the Software without +;;;; restriction, including without limitation the rights to use, +;;;; copy, modify, merge, publish, distribute, sublicense, and/or sell +;;;; copies of the Software, and to permit persons to whom the +;;;; Software is furnished to do so, subject to the following +;;;; conditions: +;;;; +;;;; The above copyright notice and this permission notice shall be +;;;; included in all copies or substantial portions of the Software. +;;;; +;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES +;;;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT +;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, +;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +;;;; OTHER DEALINGS IN THE SOFTWARE. (defpackage #:quad-double-internal (:use #:cl #+cmu #:extensions) --- /project/oct/cvsroot/oct/qd-rep.lisp 2007/06/02 12:20:25 1.3 +++ /project/oct/cvsroot/oct/qd-rep.lisp 2007/08/25 17:08:48 1.4 @@ -1,4 +1,27 @@ -;;; -*- Mode: lisp -*- +;;;; -*- Mode: lisp -*- +;;;; +;;;; Copyright (c) 2007 Raymond Toy +;;;; +;;;; Permission is hereby granted, free of charge, to any person +;;;; obtaining a copy of this software and associated documentation +;;;; files (the "Software"), to deal in the Software without +;;;; restriction, including without limitation the rights to use, +;;;; copy, modify, merge, publish, distribute, sublicense, and/or sell +;;;; copies of the Software, and to permit persons to whom the +;;;; Software is furnished to do so, subject to the following +;;;; conditions: +;;;; +;;;; The above copyright notice and this permission notice shall be +;;;; included in all copies or substantial portions of the Software. +;;;; +;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES +;;;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT +;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, +;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +;;;; OTHER DEALINGS IN THE SOFTWARE. (in-package #:qdi) --- /project/oct/cvsroot/oct/qd.lisp 2007/08/24 20:57:23 1.44 +++ /project/oct/cvsroot/oct/qd.lisp 2007/08/25 17:08:48 1.45 @@ -1,4 +1,27 @@ ;;;; -*- Mode: lisp -*- +;;;; +;;;; Copyright (c) 2007 Raymond Toy +;;;; +;;;; Permission is hereby granted, free of charge, to any person +;;;; obtaining a copy of this software and associated documentation +;;;; files (the "Software"), to deal in the Software without +;;;; restriction, including without limitation the rights to use, +;;;; copy, modify, merge, publish, distribute, sublicense, and/or sell +;;;; copies of the Software, and to permit persons to whom the +;;;; Software is furnished to do so, subject to the following +;;;; conditions: +;;;; +;;;; The above copyright notice and this permission notice shall be +;;;; included in all copies or substantial portions of the Software. +;;;; +;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES +;;;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT +;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, +;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +;;;; OTHER DEALINGS IN THE SOFTWARE. ;;; This file contains the core routines for basic arithmetic ;;; operations on a %quad-double. This includes addition, From rtoy at common-lisp.net Sat Aug 25 18:49:12 2007 From: rtoy at common-lisp.net (rtoy) Date: Sat, 25 Aug 2007 14:49:12 -0400 (EDT) Subject: [oct-cvs] Oct commit: oct qd-test.lisp Message-ID: <20070825184912.142F444070@common-lisp.net> Update of /project/oct/cvsroot/oct In directory clnet:/tmp/cvs-serv19626 Modified Files: qd-test.lisp Log Message: Add license information (MIT). --- /project/oct/cvsroot/oct/qd-test.lisp 2007/06/01 13:31:19 1.16 +++ /project/oct/cvsroot/oct/qd-test.lisp 2007/08/25 18:49:11 1.17 @@ -1,4 +1,28 @@ -;;; -*- Mode: lisp -*- +;;;; -*- Mode: lisp -*- +;;;; +;;;; Copyright (c) 2007 Raymond Toy +;;;; +;;;; Permission is hereby granted, free of charge, to any person +;;;; obtaining a copy of this software and associated documentation +;;;; files (the "Software"), to deal in the Software without +;;;; restriction, including without limitation the rights to use, +;;;; copy, modify, merge, publish, distribute, sublicense, and/or sell +;;;; copies of the Software, and to permit persons to whom the +;;;; Software is furnished to do so, subject to the following +;;;; conditions: +;;;; +;;;; The above copyright notice and this permission notice shall be +;;;; included in all copies or substantial portions of the Software. +;;;; +;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES +;;;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT +;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, +;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING +;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR +;;;; OTHER DEALINGS IN THE SOFTWARE. + (in-package "QDI") From rtoy at common-lisp.net Sat Aug 25 18:49:27 2007 From: rtoy at common-lisp.net (rtoy) Date: Sat, 25 Aug 2007 14:49:27 -0400 (EDT) Subject: [oct-cvs] Oct commit: oct branch-test.lisp tests.lisp timing.lisp Message-ID: <20070825184927.848BD44071@common-lisp.net> Update of /project/oct/cvsroot/oct In directory clnet:/tmp/cvs-serv19661 Added Files: branch-test.lisp tests.lisp timing.lisp Log Message: Initial revision. --- /project/oct/cvsroot/oct/branch-test.lisp 2007/08/25 18:49:27 NONE +++ /project/oct/cvsroot/oct/branch-test.lisp 2007/08/25 18:49:27 1.1 ;;;; -*- Mode: lisp -*- ;;;; ;;;; Copyright (c) 2007 Raymond Toy ;;;; ;;;; Permission is hereby granted, free of charge, to any person ;;;; obtaining a copy of this software and associated documentation ;;;; files (the "Software"), to deal in the Software without ;;;; restriction, including without limitation the rights to use, ;;;; copy, modify, merge, publish, distribute, sublicense, and/or sell ;;;; copies of the Software, and to permit persons to whom the ;;;; Software is furnished to do so, subject to the following ;;;; conditions: ;;;; ;;;; The above copyright notice and this permission notice shall be ;;;; included in all copies or substantial portions of the Software. ;;;; ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES ;;;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING ;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR ;;;; OTHER DEALINGS IN THE SOFTWARE. ;;; Some simple tests to see that we're computing the branch cuts ;;; correctly. ;;; ;;; NOTE: the tests assume that the functions for double-float are ;;; computing the values correctly for the branch cuts. We need to ;;; fix this. (in-package #:qd) (defun check-signs (fun arg real-sign imag-sign) (let* ((z (funcall fun arg)) (x (realpart z)) (y (imagpart z))) (unless (and (= (float-sign x) real-sign) (= (float-sign y) imag-sign)) (format t "Sign of result doesn't match expected signs~%~ ~& fun = ~A~ ~& arg = ~A~ ~& res = ~A~ ~& expected = ~A ~A~%" fun arg z real-sign imag-sign)))) (defun get-signs (z) (values (float-sign (realpart z)) (float-sign (imagpart z)))) ;; asin branch cut is the real axis |x| > 1. For x < -1, it is ;; continuous with quadrant II; for x > 1, continuous with quadrant ;; IV. (defun test-asin () ;; Check x < -1 (multiple-value-bind (tr ti) (get-signs (asin #c(-2d0 +1d-20))) (check-signs #'asin -2d0 tr ti) (check-signs #'asin -2w0 tr ti) (check-signs #'asin #q-2 tr ti) (check-signs #'asin #c(-2d0 0d0) tr ti) (check-signs #'asin #c(-2w0 0w0) tr ti) (check-signs #'asin #q(-2 0) tr ti) (check-signs #'asin #c(-2d0 -0d0) tr (- ti)) (check-signs #'asin #c(-2w0 -0w0) tr (- ti)) (check-signs #'asin #q(-2 #q-0q0) tr (- ti)) ) ;; Check x > 1 (multiple-value-bind (tr ti) (get-signs (asin #c(2d0 -1d-20))) (check-signs #'asin 2d0 tr ti) (check-signs #'asin 2w0 tr ti) (check-signs #'asin #q2 tr ti) (check-signs #'asin #c(2d0 -0d0) tr ti) (check-signs #'asin #c(2w0 -0w0) tr ti) (check-signs #'asin #q(2 #q-0q0) tr ti))) ;; acos branch cut is the real axis, |x| > 1. For x < -1, it is ;; continuous with quadrant II; for x > 1, quadrant IV. (defun test-acos () ;; Check x < -1 (multiple-value-bind (tr ti) (get-signs (acos #c(-2d0 +1d-20))) (check-signs #'acos -2d0 tr ti) (check-signs #'acos -2w0 tr ti) (check-signs #'acos #q-2 tr ti)) ;; Check x > 1 (multiple-value-bind (tr ti) (get-signs (acos #c(2d0 -1d-20))) (check-signs #'acos 2d0 tr ti) (check-signs #'acos 2w0 tr ti) (check-signs #'acos #q2 tr ti))) ;; atan branch cut is the imaginary axis, |y| > 1. For y < -1, it is ;; continuous with quadrant IV; for x > 1, quadrant II. (defun test-atan () ;; Check y < -1 (multiple-value-bind (tr ti) (get-signs (atan #c(1d-20 -2d0))) (check-signs #'atan #c(0d0 -2d0) tr ti) (check-signs #'atan #c(0w0 -2w0) tr ti) (check-signs #'atan #q(#q0 #q-2) tr ti)) ;; Check y > 1 (multiple-value-bind (tr ti) (get-signs (atan #c(-1d-20 2d0))) (check-signs #'atan #c(-0d0 2d0) tr ti) (check-signs #'atan #c(-0w0 2w0) tr ti) (check-signs #'atan #q(#q-0 2) tr ti))) (defun test-atanh () ;; Check x < -1 (multiple-value-bind (tr ti) (get-signs (atanh #c(-2d0 -1d-20))) (check-signs #'atanh -2d0 tr ti) (check-signs #'atanh -2w0 tr ti) (check-signs #'atanh #q-2 tr ti)) ;; Check x > 1 (multiple-value-bind (tr ti) (get-signs (atanh #c(2d0 1d-20))) (check-signs #'atanh 2d0 tr ti) (check-signs #'atanh 2w0 tr ti) (check-signs #'atanh #q2 tr ti))) --- /project/oct/cvsroot/oct/tests.lisp 2007/08/25 18:49:27 NONE +++ /project/oct/cvsroot/oct/tests.lisp 2007/08/25 18:49:27 1.1 ;;;; -*- Mode: lisp -*- ;;;; ;;;; Copyright (c) 2007 Raymond Toy ;;;; ;;;; Permission is hereby granted, free of charge, to any person ;;;; obtaining a copy of this software and associated documentation ;;;; files (the "Software"), to deal in the Software without ;;;; restriction, including without limitation the rights to use, ;;;; copy, modify, merge, publish, distribute, sublicense, and/or sell ;;;; copies of the Software, and to permit persons to whom the ;;;; Software is furnished to do so, subject to the following ;;;; conditions: ;;;; ;;;; The above copyright notice and this permission notice shall be ;;;; included in all copies or substantial portions of the Software. ;;;; ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES ;;;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING ;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR ;;;; OTHER DEALINGS IN THE SOFTWARE. (in-package #:qd) (defun bit-accuracy (est true) (let* ((diff (abs (- est true))) (err (float (if (zerop true) diff (/ diff (abs true))) 1d0))) (if (zerop diff) t (- (log err 2))))) (defun print-result (est true) (format t "est: ~A~%" est) (format t "tru: ~A~%" true) (format t "err: ~A~%" (float (- est true) 1d0)) (format t "bits: ~,1f~%" (bit-accuracy est true))) (defconstant +e+ (make-instance 'qd-real :value qdi::+qd-e+)) (defconstant +log2+ (make-instance 'qd-real :value qdi::+qd-log2+)) (defun test2 () ;; pi/4 = 4 * arctan(1/5) - arctan(1/239) ;; ;; Arctan is computed using the Taylor series ;; ;; arctan(x) = x - x^3/3 + x^5/5 - x^7/7 (flet ((atan-series (x) (let* ((d 1d0) (eps (float (scale-float 1d0 -212) #q1)) (tmp x) (r (* tmp tmp)) (s1 #q0) (k 0) (sign 1)) (loop while (> tmp eps) do (incf k) (setf s1 (if (minusp sign) (- s1 (/ tmp d)) (+ s1 (/ tmp d)))) (incf d 2d0) (setf tmp (* tmp r)) (setf sign (- sign))) s1))) (let* ((x1 (/ #q1 5)) (s1 (atan-series x1)) (x2 (/ #q1 239)) (s2 (atan-series x2)) (p (* (- (* s1 4) s2) 4))) (format t "~2&pi via Machin's atan formula~%") (print-result p +pi+) p))) (defun test3 () (declare (optimize (speed 3))) ;; Salamin-Brent Quadratic formula for pi (let* ((a #q1) (b (sqrt #q.5)) (s #q.5) (m 1d0) (p (/ (* (* a a) 2d0) s))) (declare (double-float m)) (dotimes (k 9) (setf m (* 2 m)) (let* ((a-new (* (+ a b) .5d0)) (b-new (sqrt (* a b))) (s-new (- s (* (- (* a-new a-new) (* b-new b-new)) m)))) (setf a a-new) (setf b b-new) (setf s s-new) (setf p (/ (* (* a a) 2d0) s)))) (format t "~2&Salamin-Brent Quadratic formula for pi~%") (print-result p +pi+) p)) (defun test4 () (declare (optimize (speed 3))) ;; Borwein Quartic formula for pi (let* ((a (- 6 (* (sqrt #q2) 4))) (y (- (sqrt #q2) 1)) (m 2d0) (p (/ a))) (declare (double-float m)) (dotimes (k 9) (setf m (* 4 m)) (let ((r (expt (- 1 (expt y 4)) 1/4))) (setf y (/ (- 1d0 r) (+ 1d0 r))) (setf a (- (* a (expt (+ y 1d0) 4)) (* (* y (+ (+ y (expt y 2)) 1d0)) m))) (setf p (/ a)))) (format t "~2&Borwein's Quartic formula for pi~%") (print-result p +pi+) p)) (defun test5 () ;; Taylor series for e (let ((s #q2) (tmp #q1) (n 1d0) (delta 0d0) (i 0)) (loop while (> tmp 1d-100) do (incf i) (incf n) (setf tmp (/ tmp n)) (setf s (+ s tmp))) (format t "~2&e via Taylor series~%") (print-result s +e+) s)) (defun test6 () ;; Taylor series for log 2 ;; ;; -log(1-x) = x + x^2/2 + x^3/3 + x^4/4 + ... ;; ;; with x = 1/2 to get log(1/2) = -log(2) (let ((s #q.5) (tt #q.5) (n 1d0) (i 0)) (loop while (> tt 1d-100) do (incf i) (incf n) (setf tt (* tt .5d0)) (setf s (+ s (/ tt n)))) (format t "~2&log(2) via Taylor series~%") (print-result s +log2+) s)) (defun test-atan () (let* ((arg (/ (sqrt #q3))) (y (/ (atan arg) +pi+)) (true (/ #q6))) (format t "~2&atan for special args~%") (format t "atan(1/sqrt(3))/pi = 1/6~%") (print-result y true)) ;; atan(sqrt(3)) = %pi/3 (let* ((arg (sqrt #q3)) (y (/ (atan arg) +pi+)) (true (/ #q3))) (format t "atan(sqrt(3))/pi = 1/3~%") (print-result y true)) ;; atan(1) = %pi/4 (let* ((arg #q1) (y (/ (atan arg) +pi+)) (true (/ #q4))) (format t "atan(1)/pi = 1/4~%") (print-result y true)) (let* ((arg #q1q100) (y (/ (atan arg) +pi+)) (true #q.5)) (format t "atan(1q100)/pi = 1/2~%") (print-result y true)) (let* ((arg #q-1q100) (y (/ (atan arg) +pi+)) (true #q-.5)) (format t "atan(-1q100)/pi = -1/2~%") (print-result y true))) (defun test-sin () (format t "~2&sin for special args~%") (let* ((arg (/ +pi+ 6)) (y (sin arg)) (true #q.5)) (format t "sin(pi/6) = 1/2~%") (print-result y true)) (let* ((arg (/ +pi+ 4)) (y (sin arg)) (true (sqrt #q.5))) (format t "sin(pi/4) = 1/sqrt(2)~%") (print-result y true)) (let* ((arg (/ +pi+ 3)) (y (sin arg)) (true (/ (sqrt #q3) 2))) (format t "sin(pi/3) = sqrt(3)/2~%") (print-result y true))) (defun test-tan () (format t "~2&tan for special args~%") (let* ((arg (/ +pi+ 6)) (y (tan arg)) (true (/ (sqrt #q3)))) (format t"tan(pi/6) = 1/sqrt(3)~%") (print-result y true)) (let* ((arg (/ +pi+ 4)) (y (tan arg)) (true #q1)) (format t "tan(pi/4) = 1~%") (print-result y true)) (let* ((arg (/ +pi+ 3)) (y (tan arg)) (true (sqrt #q3))) (format t "tan(pi/3) = sqrt(3)~%") (print-result y true))) (defun test-asin () (format t "~2&asin for special args~%") (let* ((arg #q.5) (y (asin arg)) (true (/ +pi+ 6))) (format t "asin(1/2) = pi/6~%") (print-result y true)) (let* ((arg (sqrt #q.5)) (y (asin arg)) (true (/ +pi+ 4))) (format t "asin(1/sqrt(2) = pi/4~%") (print-result y true)) (let* ((arg (/ (sqrt #q3) 2)) (y (asin arg)) (true (/ +pi+ 3))) (format t "asin(sqrt(3)/2) = pi/3~%") (print-result y true))) (defun test-log () (format t "~2&Log for special args~%") (let* ((arg #q2) (y (log arg)) (true +log2+)) (format t "log(2)~%") (print-result y true)) [36 lines skipped] --- /project/oct/cvsroot/oct/timing.lisp 2007/08/25 18:49:27 NONE +++ /project/oct/cvsroot/oct/timing.lisp 2007/08/25 18:49:27 1.1 [212 lines skipped] From rtoy at common-lisp.net Sat Aug 25 21:17:04 2007 From: rtoy at common-lisp.net (rtoy) Date: Sat, 25 Aug 2007 17:17:04 -0400 (EDT) Subject: [oct-cvs] Oct commit: oct qd-methods.lisp Message-ID: <20070825211704.07972360E2@common-lisp.net> Update of /project/oct/cvsroot/oct In directory clnet:/tmp/cvs-serv10436 Modified Files: qd-methods.lisp Log Message: Fix typo. --- /project/oct/cvsroot/oct/qd-methods.lisp 2007/08/25 17:08:48 1.46 +++ /project/oct/cvsroot/oct/qd-methods.lisp 2007/08/25 21:17:03 1.47 @@ -813,7 +813,7 @@ (complex (float (realpart number) #q0) (float (imagpart number) #q0))) -(defmethod coerce ((number qd-complex) (type (eql qd-complex))) +(defmethod coerce ((number qd-complex) (type (eql 'qd-complex))) number) From rtoy at common-lisp.net Sun Aug 26 14:37:48 2007 From: rtoy at common-lisp.net (rtoy) Date: Sun, 26 Aug 2007 10:37:48 -0400 (EDT) Subject: [oct-cvs] Oct commit: oct qd-complex.lisp qd-methods.lisp qd-package.lisp Message-ID: <20070826143748.5046F72128@common-lisp.net> Update of /project/oct/cvsroot/oct In directory clnet:/tmp/cvs-serv32505 Modified Files: qd-complex.lisp qd-methods.lisp qd-package.lisp Log Message: qd-methods.lisp: o Oops. Move COERCE to qd-complex.lisp because we use the #q reader macro. (This needs to be reorganized better.) o Add RANDOM methods so we can generate quad-double random numbers. qd-package.lisp: o Shadow RANDOM so we can add our own RANDOM to generate quad-doubles. qd-complex.lisp: o COERCE moved here. --- /project/oct/cvsroot/oct/qd-complex.lisp 2007/08/25 17:08:48 1.27 +++ /project/oct/cvsroot/oct/qd-complex.lisp 2007/08/26 14:37:48 1.28 @@ -209,6 +209,22 @@ (defmethod unary-divide ((a qd-complex)) (two-arg-/ #q1 a)) +(defmethod coerce ((obj t) (type t)) + (cl:coerce obj type)) + +(defmethod coerce ((number cl:real) (type (eql 'qd-real))) + (float number #q0)) + +(defmethod coerce ((number qd-real) (type (eql 'qd-real))) + number) + +(defmethod coerce ((number cl:number) (type (eql 'qd-complex))) + (complex (float (realpart number) #q0) + (float (imagpart number) #q0))) + +(defmethod coerce ((number qd-complex) (type (eql 'qd-complex))) + number) + (declaim (inline square)) (defun square (x) (declare (type qd-real x)) --- /project/oct/cvsroot/oct/qd-methods.lisp 2007/08/25 21:17:03 1.47 +++ /project/oct/cvsroot/oct/qd-methods.lisp 2007/08/26 14:37:48 1.48 @@ -800,22 +800,12 @@ (if (plusp number) 1 -1) (/ number (abs number))))) -(defmethod coerce ((obj t) (type t)) - (cl:coerce obj type)) - -(defmethod coerce ((number cl:real) (type (eql 'qd-real))) - (float number #q0)) - -(defmethod coerce ((number qd-real) (type (eql 'qd-real))) - number) - -(defmethod coerce ((number cl:number) (type (eql 'qd-complex))) - (complex (float (realpart number) #q0) - (float (imagpart number) #q0))) - -(defmethod coerce ((number qd-complex) (type (eql 'qd-complex))) - number) +(defmethod random ((x cl:real) &optional (state *random-state*)) + (cl:random x state)) +(defmethod random ((x qd-real) &optional (state *random-state*)) + (* x (make-instance 'qd-real + :value (qdi:random-qd state)))) (define-compiler-macro + (&whole form &rest args) (if (null args) --- /project/oct/cvsroot/oct/qd-package.lisp 2007/08/25 17:08:48 1.32 +++ /project/oct/cvsroot/oct/qd-package.lisp 2007/08/26 14:37:48 1.33 @@ -88,6 +88,7 @@ #:decode-float-qd #:scale-float-qd #:ffloor-qd + #:random-qd ) #+cmu (:import-from #:c @@ -155,6 +156,7 @@ #:phase #:signum #:coerce + #:random ) (:export #:+ #:- @@ -212,6 +214,7 @@ #:phase #:signum #:coerce + #:random ) ;; Constants (:export #:+pi+) From rtoy at common-lisp.net Mon Aug 27 13:10:50 2007 From: rtoy at common-lisp.net (rtoy) Date: Mon, 27 Aug 2007 09:10:50 -0400 (EDT) Subject: [oct-cvs] Oct commit: oct .cvsignore Message-ID: <20070827131050.CAAD925002@common-lisp.net> Update of /project/oct/cvsroot/oct In directory clnet:/tmp/cvs-serv15495 Modified Files: .cvsignore Log Message: Ignore more fasl types. --- /project/oct/cvsroot/oct/.cvsignore 2007/08/25 16:16:53 1.1 +++ /project/oct/cvsroot/oct/.cvsignore 2007/08/27 13:10:50 1.2 @@ -1,2 +1,4 @@ *.ppcf +*.sparcf +*.x86f *.err From rtoy at common-lisp.net Mon Aug 27 17:49:21 2007 From: rtoy at common-lisp.net (rtoy) Date: Mon, 27 Aug 2007 13:49:21 -0400 (EDT) Subject: [oct-cvs] Oct commit: oct qd-class.lisp qd-complex.lisp qd-const.lisp qd-format.lisp qd-io.lisp qd-methods.lisp qd-test.lisp timing.lisp Message-ID: <20070827174921.0792A2F04E@common-lisp.net> Update of /project/oct/cvsroot/oct In directory clnet:/tmp/cvs-serv30973 Modified Files: qd-class.lisp qd-complex.lisp qd-const.lisp qd-format.lisp qd-io.lisp qd-methods.lisp qd-test.lisp timing.lisp Log Message: Use uninterned symbols for IN-PACKAGE. --- /project/oct/cvsroot/oct/qd-class.lisp 2007/08/25 17:08:48 1.20 +++ /project/oct/cvsroot/oct/qd-class.lisp 2007/08/27 17:49:19 1.21 @@ -23,7 +23,7 @@ ;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR ;;;; OTHER DEALINGS IN THE SOFTWARE. -(in-package "QD") +(in-package #:qd) (define-symbol-macro * cl:*) (define-symbol-macro - cl:-) --- /project/oct/cvsroot/oct/qd-complex.lisp 2007/08/26 14:37:48 1.28 +++ /project/oct/cvsroot/oct/qd-complex.lisp 2007/08/27 17:49:19 1.29 @@ -26,7 +26,7 @@ ;; Most of this code taken from CMUCL and slightly modified to support ;; QD-COMPLEX. -(in-package "QD") +(in-package #:qd) (defmethod two-arg-/ ((a qd-real) (b rational)) (make-instance 'qd-real :value (div-qd (qd-value a) --- /project/oct/cvsroot/oct/qd-const.lisp 2007/08/25 17:08:48 1.15 +++ /project/oct/cvsroot/oct/qd-const.lisp 2007/08/27 17:49:19 1.16 @@ -23,7 +23,7 @@ ;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR ;;;; OTHER DEALINGS IN THE SOFTWARE. -(in-package "QDI") +(in-package #:qdi) (defconstant +qd-zero+ (make-qd-d 0d0)) --- /project/oct/cvsroot/oct/qd-format.lisp 2007/08/25 17:08:48 1.4 +++ /project/oct/cvsroot/oct/qd-format.lisp 2007/08/27 17:49:19 1.5 @@ -23,7 +23,7 @@ ;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR ;;;; OTHER DEALINGS IN THE SOFTWARE. -(in-package "QD") +(in-package #:qd) (defun qd-scale-exponent (original-x) (let* ((x original-x)) --- /project/oct/cvsroot/oct/qd-io.lisp 2007/08/25 17:08:48 1.13 +++ /project/oct/cvsroot/oct/qd-io.lisp 2007/08/27 17:49:19 1.14 @@ -23,7 +23,7 @@ ;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR ;;;; OTHER DEALINGS IN THE SOFTWARE. -(in-package "QDI") +(in-package #:qdi) ;; Smallest exponent for a double-float. (eval-when (:compile-toplevel :load-toplevel :execute) --- /project/oct/cvsroot/oct/qd-methods.lisp 2007/08/26 14:37:48 1.48 +++ /project/oct/cvsroot/oct/qd-methods.lisp 2007/08/27 17:49:19 1.49 @@ -23,7 +23,7 @@ ;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR ;;;; OTHER DEALINGS IN THE SOFTWARE. -(in-package "QD") +(in-package #:qd) (defconstant +pi+ (make-instance 'qd-real :value qdi:+qd-pi+)) --- /project/oct/cvsroot/oct/qd-test.lisp 2007/08/25 18:49:11 1.17 +++ /project/oct/cvsroot/oct/qd-test.lisp 2007/08/27 17:49:19 1.18 @@ -24,7 +24,7 @@ ;;;; OTHER DEALINGS IN THE SOFTWARE. -(in-package "QDI") +(in-package #:qdi) ;; Compute to how many bits EST and TRUE are equal. If they are ;; identical, return T. --- /project/oct/cvsroot/oct/timing.lisp 2007/08/25 18:49:27 1.1 +++ /project/oct/cvsroot/oct/timing.lisp 2007/08/27 17:49:19 1.2 @@ -25,7 +25,7 @@ ;;; Some simple timing tests -(in-package "OCT") +(in-package #:oct) (defun time-add (&optional (n 100000)) (declare (fixnum n)) From rtoy at common-lisp.net Mon Aug 27 17:51:02 2007 From: rtoy at common-lisp.net (rtoy) Date: Mon, 27 Aug 2007 13:51:02 -0400 (EDT) Subject: [oct-cvs] Oct commit: oct oct-test.system oct.system Message-ID: <20070827175102.611253202E@common-lisp.net> Update of /project/oct/cvsroot/oct In directory clnet:/tmp/cvs-serv31223 Modified Files: oct.system Added Files: oct-test.system Log Message: Moved OCT-TEST system to its own file. --- /project/oct/cvsroot/oct/oct.system 2007/08/25 17:08:48 1.20 +++ /project/oct/cvsroot/oct/oct.system 2007/08/27 17:51:02 1.21 @@ -70,17 +70,3 @@ )) -(mk:defsystem oct-extras - :source-pathname (make-pathname :directory (pathname-directory *load-pathname*)) - :depends-on ("oct") - :components - ((:file "qd-extra"))) - -(mk:defsystem oct-test - :source-pathname (make-pathname :directory (pathname-directory *load-pathname*)) - :depends-on ("oct" "oct-extras") - :components - ((:file "qd-test") - (:file "tests") - (:file "branch-test"))) - --- /project/oct/cvsroot/oct/oct-test.system 2007/08/27 17:51:02 NONE +++ /project/oct/cvsroot/oct/oct-test.system 2007/08/27 17:51:02 1.1 ;;;; -*- Mode: lisp -*- ;;;; ;;;; Copyright (c) 2007 Raymond Toy ;;;; ;;;; Permission is hereby granted, free of charge, to any person ;;;; obtaining a copy of this software and associated documentation ;;;; files (the "Software"), to deal in the Software without ;;;; restriction, including without limitation the rights to use, ;;;; copy, modify, merge, publish, distribute, sublicense, and/or sell ;;;; copies of the Software, and to permit persons to whom the ;;;; Software is furnished to do so, subject to the following ;;;; conditions: ;;;; ;;;; The above copyright notice and this permission notice shall be ;;;; included in all copies or substantial portions of the Software. ;;;; ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES ;;;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING ;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR ;;;; OTHER DEALINGS IN THE SOFTWARE. (require :rt) (mk:defsystem oct-extras :source-pathname (make-pathname :directory (pathname-directory *load-pathname*)) :depends-on ("oct") :components ((:file "qd-extra"))) (mk:defsystem oct-test :source-pathname (make-pathname :directory (pathname-directory *load-pathname*)) :depends-on ("oct" "oct-extras") :components ((:file "qd-test") ;;(:file "tests") (:file "branch-test") (:file "rt-tests"))) From rtoy at common-lisp.net Mon Aug 27 18:04:31 2007 From: rtoy at common-lisp.net (rtoy) Date: Mon, 27 Aug 2007 14:04:31 -0400 (EDT) Subject: [oct-cvs] Oct commit: oct oct-test.system Message-ID: <20070827180431.208D2100C@common-lisp.net> Update of /project/oct/cvsroot/oct In directory clnet:/tmp/cvs-serv1684 Modified Files: oct-test.system Log Message: Add comment on where to get RT. --- /project/oct/cvsroot/oct/oct-test.system 2007/08/27 17:51:02 1.1 +++ /project/oct/cvsroot/oct/oct-test.system 2007/08/27 18:04:31 1.2 @@ -23,6 +23,8 @@ ;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR ;;;; OTHER DEALINGS IN THE SOFTWARE. +;; This requres the RT package. You can obtain a copy from +;; http://www.cliki.net/RT. (require :rt) (mk:defsystem oct-extras From rtoy at common-lisp.net Mon Aug 27 18:05:12 2007 From: rtoy at common-lisp.net (rtoy) Date: Mon, 27 Aug 2007 14:05:12 -0400 (EDT) Subject: [oct-cvs] Oct commit: oct rt-tests.lisp Message-ID: <20070827180512.4D48272C1@common-lisp.net> Update of /project/oct/cvsroot/oct In directory clnet:/tmp/cvs-serv1830 Added Files: rt-tests.lisp Log Message: Tests using the RT framework. --- /project/oct/cvsroot/oct/rt-tests.lisp 2007/08/27 18:05:12 NONE +++ /project/oct/cvsroot/oct/rt-tests.lisp 2007/08/27 18:05:12 1.1 ;;;; -*- Mode: lisp -*- ;;;; ;;;; Copyright (c) 2007 Raymond Toy ;;;; ;;;; Permission is hereby granted, free of charge, to any person ;;;; obtaining a copy of this software and associated documentation ;;;; files (the "Software"), to deal in the Software without ;;;; restriction, including without limitation the rights to use, ;;;; copy, modify, merge, publish, distribute, sublicense, and/or sell ;;;; copies of the Software, and to permit persons to whom the ;;;; Software is furnished to do so, subject to the following ;;;; conditions: ;;;; ;;;; The above copyright notice and this permission notice shall be ;;;; included in all copies or substantial portions of the Software. ;;;; ;;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, ;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES ;;;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND ;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT ;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, ;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING ;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR ;;;; OTHER DEALINGS IN THE SOFTWARE. (in-package #:qd) ;; Compute how many bits are the same for two numbers EST and TRUE. ;; Return T if they are identical. (defun bit-accuracy (est true) (let* ((diff (abs (- est true))) (err (float (if (zerop true) diff (/ diff (abs true))) 1d0))) (if (zerop diff) t (- (log err 2))))) (defun check-accuracy (limit est true) (let ((bits (bit-accuracy est true))) (if (numberp bits) (if (< bits limit) (list bits limit est true))))) (defvar *null* (make-broadcast-stream)) ;;; Some simple tests from the Yozo Hida's qd package. ;; Pi via Machin's formula (rt:deftest oct.pi.machin (let* ((*standard-output* *null*) (val (make-instance 'qd-real :value (qdi::test2))) (true qd:+pi+)) (check-accuracy 213 val true)) nil) ;; Pi via Salamin-Brent algorithm (rt:deftest oct.pi.salamin-brent (let* ((*standard-output* *null*) (val (make-instance 'qd-real :value (qdi::test3))) (true qd:+pi+)) (check-accuracy 202 val true)) nil) ;; Pi via Borweign's Quartic formula (rt:deftest oct.pi.borweign (let* ((*standard-output* *null*) (val (make-instance 'qd-real :value (qdi::test4))) (true qd:+pi+)) (check-accuracy 211 val true)) nil) ;; e via Taylor series (rt:deftest oct.e.taylor (let* ((*standard-output* *null*) (val (make-instance 'qd-real :value (qdi::test5))) (true (make-instance 'qd-real :value qdi::+qd-e+))) (check-accuracy 212 val true)) nil) ;; log(2) via Taylor series (rt:deftest oct.log2.taylor (let* ((*standard-output* *null*) (val (make-instance 'qd-real :value (qdi::test6))) (true (make-instance 'qd-real :value qdi::+qd-log2+))) (check-accuracy 212 val true)) nil) ;;; Tests of atan where we know the analytical result (rt:deftest oct.atan.1 (let* ((arg (/ (sqrt #q3))) (y (/ (atan arg) +pi+)) (true (/ #q6))) (check-accuracy 212 y true)) nil) (rt:deftest oct.atan.2 (let* ((arg (sqrt #q3)) (y (/ (atan arg) +pi+)) (true (/ #q3))) (check-accuracy 212 y true)) nil) (rt:deftest oct.atan.3 (let* ((arg #q1) (y (/ (atan arg) +pi+)) (true (/ #q4))) (check-accuracy 212 y true)) nil) (rt:deftest oct.atan.4 (let* ((arg #q1q100) (y (/ (atan arg) +pi+)) (true #q.5)) (check-accuracy 212 y true)) nil) (rt:deftest oct.atan.5 (let* ((arg #q-1q100) (y (/ (atan arg) +pi+)) (true #q-.5)) (check-accuracy 212 y true)) nil) (defun atan-qd/duplication (arg) (make-instance 'qd-real :value (qdi::atan-qd/duplication (qd-value arg)))) ;;; Tests of atan where we know the analytical result. Same tests, ;;; but using the atan duplication formula. (rt:deftest oct.atan/dup.1 (let* ((arg (/ (sqrt #q3))) (y (/ (atan-qd/duplication arg) +pi+)) (true (/ #q6))) (check-accuracy 212 y true)) nil) (rt:deftest oct.atan/dup.2 (let* ((arg (sqrt #q3)) (y (/ (atan-qd/duplication arg) +pi+)) (true (/ #q3))) (check-accuracy 212 y true)) nil) (rt:deftest oct.atan/dup.3 (let* ((arg #q1) (y (/ (atan-qd/duplication arg) +pi+)) (true (/ #q4))) (check-accuracy 212 y true)) nil) (rt:deftest oct.atan/dup.4 (let* ((arg #q1q100) (y (/ (atan-qd/duplication arg) +pi+)) (true #q.5)) (check-accuracy 212 y true)) nil) (rt:deftest oct.atan/dup.5 (let* ((arg #q-1q100) (y (/ (atan-qd/duplication arg) +pi+)) (true #q-.5)) (check-accuracy 212 y true)) nil) ;;; Tests of atan where we know the analytical result. Same tests, ;;; but using a CORDIC implementation. (defun atan-qd/cordic (arg) (make-instance 'qd-real :value (qdi::atan-qd/cordic (qd-value arg)))) (rt:deftest oct.atan/cordic.1 (let* ((arg (/ (sqrt #q3))) (y (/ (atan-qd/cordic arg) +pi+)) (true (/ #q6))) (check-accuracy 212 y true)) nil) (rt:deftest oct.atan/cordic.2 (let* ((arg (sqrt #q3)) (y (/ (atan-qd/cordic arg) +pi+)) (true (/ #q3))) (check-accuracy 212 y true)) nil) (rt:deftest oct.atan/cordic.3 (let* ((arg #q1) (y (/ (atan-qd/cordic arg) +pi+)) (true (/ #q4))) (check-accuracy 212 y true)) nil) (rt:deftest oct.atan/cordic.4 (let* ((arg #q1q100) (y (/ (atan-qd/cordic arg) +pi+)) (true #q.5)) (check-accuracy 212 y true)) nil) (rt:deftest oct.atan/cordic.5 (let* ((arg #q-1q100) (y (/ (atan-qd/cordic arg) +pi+)) (true #q-.5)) (check-accuracy 212 y true)) nil) ;;; Tests of sin where we know the analytical result. (rt:deftest oct.sin.1 (let* ((arg (/ +pi+ 6)) (y (sin arg)) (true #q.5)) (check-accuracy 212 y true)) nil) (rt:deftest oct.sin.2 (let* ((arg (/ +pi+ 4)) (y (sin arg)) (true (sqrt #q.5))) (check-accuracy 212 y true)) nil) (rt:deftest oct.sin.3 (let* ((arg (/ +pi+ 3)) (y (sin arg)) (true (/ (sqrt #q3) 2))) (check-accuracy 212 y true)) nil) ;;; Tests of tan where we know the analytical result. (rt:deftest oct.tan.1 (let* ((arg (/ +pi+ 6)) (y (tan arg)) (true (/ (sqrt #q3)))) (check-accuracy 212 y true)) nil) (rt:deftest oct.tan.2 (let* ((arg (/ +pi+ 4)) (y (tan arg)) (true #q1)) (check-accuracy 212 y true)) nil) (rt:deftest oct.tan.3 (let* ((arg (/ +pi+ 3)) (y (tan arg)) (true (sqrt #q3))) (check-accuracy 212 y true)) nil) ;;; Tests of tan where we know the analytical result. Uses CORDIC ;;; algorithm. (defun tan/cordic (arg) (make-instance 'qd-real :value (qdi::tan-qd/cordic (qd-value arg)))) (rt:deftest oct.tan/cordic.1 (let* ((arg (/ +pi+ 6)) (y (tan/cordic arg)) (true (/ (sqrt #q3)))) (check-accuracy 211 y true)) nil) (rt:deftest oct.tan/cordic.2 (let* ((arg (/ +pi+ 4)) (y (tan/cordic arg)) (true #q1)) (check-accuracy 211 y true)) nil) (rt:deftest oct.tan/cordic.3 (let* ((arg (/ +pi+ 3)) (y (tan/cordic arg)) (true (sqrt #q3))) (check-accuracy 210 y true)) nil) ;;; Tests of asin where we know the analytical result. (rt:deftest oct.asin.1 (let* ((arg #q.5) (y (asin arg)) (true (/ +pi+ 6))) (check-accuracy 212 y true)) nil) (rt:deftest oct.asin.2 (let* ((arg (sqrt #q.5)) (y (asin arg)) (true (/ +pi+ 4))) (check-accuracy 212 y true)) nil) (rt:deftest oct.asin.3 (let* ((arg (/ (sqrt #q3) 2)) (y (asin arg)) (true (/ +pi+ 3))) (check-accuracy 212 y true)) nil) ;;; Tests of log. (rt:deftest oct.log.1 (let* ((arg #q2) (y (log arg)) (true (make-instance 'qd-real :value qdi::+qd-log2+))) (check-accuracy 212 y true)) nil) (rt:deftest oct.log.2 (let* ((arg #q10) (y (log arg)) (true (make-instance 'qd-real :value qdi::+qd-log10+))) (check-accuracy 207 y true)) nil) (rt:deftest oct.log.3 (let* ((arg (+ 1 (scale-float #q1 -80))) (y (log arg)) (true #q8.2718061255302767487140834995607996176476940491239977084112840149578911975528492q-25)) (check-accuracy 212 y true)) nil) ;;; Tests of log using Newton iteration. (defun log/newton (arg) (make-instance 'qd-real :value (qdi::log-qd/newton (qd-value arg)))) (rt:deftest oct.log/newton.1 (let* ((arg #q2) (y (log/newton arg)) (true (make-instance 'qd-real :value qdi::+qd-log2+))) (check-accuracy 212 y true)) nil) (rt:deftest oct.log/newton.2 (let* ((arg #q10) (y (log/newton arg)) (true (make-instance 'qd-real :value qdi::+qd-log10+))) (check-accuracy 207 y true)) nil) (rt:deftest oct.log/newton.3 (let* ((arg (+ 1 (scale-float #q1 -80))) (y (log/newton arg)) (true #q8.2718061255302767487140834995607996176476940491239977084112840149578911975528492q-25)) (check-accuracy 212 y true)) nil) ;;; Tests of log using AGM. (defun log/agm (arg) (make-instance 'qd-real :value (qdi::log-qd/agm (qd-value arg)))) (rt:deftest oct.log/agm.1 (let* ((arg #q2) (y (log/agm arg)) (true (make-instance 'qd-real :value qdi::+qd-log2+))) (check-accuracy 203 y true)) nil) (rt:deftest oct.log/agm.2 (let* ((arg #q10) (y (log/agm arg)) (true (make-instance 'qd-real :value qdi::+qd-log10+))) (check-accuracy 205 y true)) nil) (rt:deftest oct.log/agm.3 (let* ((arg (+ 1 (scale-float #q1 -80))) (y (log/agm arg)) (true #q8.2718061255302767487140834995607996176476940491239977084112840149578911975528492q-25)) (check-accuracy 123 y true)) nil) ;;; Tests of log using AGM2, a faster variaton of AGM. (defun log/agm2 (arg) (make-instance 'qd-real :value (qdi::log-qd/agm2 (qd-value arg)))) (rt:deftest oct.log/agm2.1 (let* ((arg #q2) (y (log/agm2 arg)) (true (make-instance 'qd-real :value qdi::+qd-log2+))) (check-accuracy 203 y true)) nil) (rt:deftest oct.log/agm2.2 (let* ((arg #q10) (y (log/agm2 arg)) (true (make-instance 'qd-real :value qdi::+qd-log10+))) (check-accuracy 205 y true)) nil) [147 lines skipped] From rtoy at common-lisp.net Mon Aug 27 19:12:22 2007 From: rtoy at common-lisp.net (rtoy) Date: Mon, 27 Aug 2007 15:12:22 -0400 (EDT) Subject: [oct-cvs] Oct commit: oct qd-class.lisp Message-ID: <20070827191222.C4D0B7B49D@common-lisp.net> Update of /project/oct/cvsroot/oct In directory clnet:/tmp/cvs-serv13325 Modified Files: qd-class.lisp Log Message: o Fix typo in DESCRIBE-OBJECT for QD-REAL. o Add DESCRIBE-OJBECT method for QD-COMPLEX. o Add defgeneric's for COERCE and RANDOM. --- /project/oct/cvsroot/oct/qd-class.lisp 2007/08/27 17:49:19 1.21 +++ /project/oct/cvsroot/oct/qd-class.lisp 2007/08/27 19:12:22 1.22 @@ -95,10 +95,17 @@ (defmethod describe-object ((q qd-real) stream) (multiple-value-bind (q0 q1 q2 q3) (qd-parts (qd-value q)) - (format stream "~&~S is a quad-double with components ~ + (format stream "~&~S is a QD-REAL with components ~ ~% ~A, ~A, ~A, ~A~%" q q0 q1 q2 q3))) +(defmethod describe-object ((q qd-complex) stream) + (format stream "~&~S is a QD-COMPLEX" q) + (format stream "~&It has components~&REAL: ") + (describe (realpart q)) + (format stream "~&IMAG: ") + (describe (imagpart q))) + (defgeneric add1 (a) (:documentation "Add 1")) @@ -240,3 +247,10 @@ (defgeneric qphase (x) (:documentation "Phase of X")) + +(defgeneric coerce (x type) + (:documentation "COERCE")) + +(defgeneric random (x &optional state) + (:documentation "RANDOM")) + From rtoy at common-lisp.net Tue Aug 28 00:56:18 2007 From: rtoy at common-lisp.net (rtoy) Date: Mon, 27 Aug 2007 20:56:18 -0400 (EDT) Subject: [oct-cvs] Oct commit: oct qd-complex.lisp qd-package.lisp Message-ID: <20070828005618.EADB27A001@common-lisp.net> Update of /project/oct/cvsroot/oct In directory clnet:/tmp/cvs-serv27512 Modified Files: qd-complex.lisp qd-package.lisp Log Message: qd-package.lisp: o Shadow REALP, COMPLEXP, and NUMBERP qd-complex.lisp: o Extend REALP, COMPLEXP, and NUMBERP to recognize QD-REAL and QD-COMPLEX types. --- /project/oct/cvsroot/oct/qd-complex.lisp 2007/08/27 17:49:19 1.29 +++ /project/oct/cvsroot/oct/qd-complex.lisp 2007/08/28 00:56:18 1.30 @@ -679,3 +679,15 @@ (defmethod qphase ((z qd-complex)) (atan (imagpart z) (realpart z))) + +(defun realp (x) + (or (typep x 'qd-real) + (cl:realp x))) + +(defun complexp (x) + (or (typep x 'qd-complex) + (cl:complexp x))) + +(defun numberp (x) + (or (realp x) + (complexp x))) --- /project/oct/cvsroot/oct/qd-package.lisp 2007/08/26 14:37:48 1.33 +++ /project/oct/cvsroot/oct/qd-package.lisp 2007/08/28 00:56:18 1.34 @@ -215,6 +215,9 @@ #:signum #:coerce #:random + #:realp + #:complexp + #:numberp ) ;; Constants (:export #:+pi+) From rtoy at common-lisp.net Tue Aug 28 14:12:53 2007 From: rtoy at common-lisp.net (rtoy) Date: Tue, 28 Aug 2007 10:12:53 -0400 (EDT) Subject: [oct-cvs] Oct commit: oct qd-complex.lisp Message-ID: <20070828141253.96CAB2500A@common-lisp.net> Update of /project/oct/cvsroot/oct In directory clnet:/tmp/cvs-serv3944 Modified Files: qd-complex.lisp Log Message: Add ADD1 method for QD-COMPLEX. --- /project/oct/cvsroot/oct/qd-complex.lisp 2007/08/28 00:56:18 1.30 +++ /project/oct/cvsroot/oct/qd-complex.lisp 2007/08/28 14:12:53 1.31 @@ -28,6 +28,11 @@ (in-package #:qd) +(defmethod add1 ((a qd-complex)) + (make-instance 'qd-complex + :real (qd-value (add1 (realpart a))) + :imag (qd-value (imagpart a)))) + (defmethod two-arg-/ ((a qd-real) (b rational)) (make-instance 'qd-real :value (div-qd (qd-value a) (qd-value (float b #q0))))) From rtoy at common-lisp.net Tue Aug 28 16:01:08 2007 From: rtoy at common-lisp.net (rtoy) Date: Tue, 28 Aug 2007 12:01:08 -0400 (EDT) Subject: [oct-cvs] Oct commit: oct qd-complex.lisp qd-package.lisp Message-ID: <20070828160108.B21ED68244@common-lisp.net> Update of /project/oct/cvsroot/oct In directory clnet:/tmp/cvs-serv28331 Modified Files: qd-complex.lisp qd-package.lisp Log Message: qd-complex.lisp: o Add ADD1 and SUB1 methods so we can use 1+ and 1- on quad-doubles. o Add INCF and DECF macros to support quad-doubles. qd-package.lisp: o Forgot to shadow REALP, COMPLEXP, and NUMBERP, previously. o Shadow and export INCF and DECF. --- /project/oct/cvsroot/oct/qd-complex.lisp 2007/08/28 14:12:53 1.31 +++ /project/oct/cvsroot/oct/qd-complex.lisp 2007/08/28 16:01:08 1.32 @@ -23,14 +23,16 @@ ;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR ;;;; OTHER DEALINGS IN THE SOFTWARE. -;; Most of this code taken from CMUCL and slightly modified to support -;; QD-COMPLEX. - (in-package #:qd) (defmethod add1 ((a qd-complex)) (make-instance 'qd-complex - :real (qd-value (add1 (realpart a))) + :real (add-qd-d (qd-value (realpart a)) 1d0) + :imag (qd-value (imagpart a)))) + +(defmethod sub1 ((a qd-complex)) + (make-instance 'qd-complex + :real (sub-qd-d (qd-value (realpart a)) 1d0) :imag (qd-value (imagpart a)))) (defmethod two-arg-/ ((a qd-real) (b rational)) @@ -230,6 +232,33 @@ (defmethod coerce ((number qd-complex) (type (eql 'qd-complex))) number) +;; These two macros are borrowed from CMUCL. +(defmacro incf (place &optional (delta 1) &environment env) + "The first argument is some location holding a number. This number is + incremented by the second argument, DELTA, which defaults to 1." + (multiple-value-bind (dummies vals newval setter getter) + (get-setf-expansion place env) + (let ((d (gensym))) + `(let* (,@(mapcar #'list dummies vals) + (,d ,delta) + (,(car newval) (+ ,getter ,d))) + ,setter)))) + +(defmacro decf (place &optional (delta 1) &environment env) + "The first argument is some location holding a number. This number is + decremented by the second argument, DELTA, which defaults to 1." + (multiple-value-bind (dummies vals newval setter getter) + (get-setf-expansion place env) + (let ((d (gensym))) + `(let* (,@(mapcar #'list dummies vals) + (,d ,delta) + (,(car newval) (- ,getter ,d))) + ,setter)))) + + +;; Most of this code taken from CMUCL and slightly modified to support +;; QD-COMPLEX. + (declaim (inline square)) (defun square (x) (declare (type qd-real x)) @@ -604,6 +633,7 @@ (result (qd-complex-tanh iz))) (complex (imagpart result) (- (realpart result))))) +;; End of implementation of complex functions from CMUCL. (defmethod qasin ((x qd-complex)) (qd-complex-asin x)) --- /project/oct/cvsroot/oct/qd-package.lisp 2007/08/28 00:56:18 1.34 +++ /project/oct/cvsroot/oct/qd-package.lisp 2007/08/28 16:01:08 1.35 @@ -157,6 +157,11 @@ #:signum #:coerce #:random + #:realp + #:complexp + #:numberp + #:incf + #:decf ) (:export #:+ #:- @@ -218,6 +223,8 @@ #:realp #:complexp #:numberp + #:incf + #:decf ) ;; Constants (:export #:+pi+) From rtoy at common-lisp.net Wed Aug 29 01:22:03 2007 From: rtoy at common-lisp.net (rtoy) Date: Tue, 28 Aug 2007 21:22:03 -0400 (EDT) Subject: [oct-cvs] Oct commit: oct qd-methods.lisp qd-package.lisp Message-ID: <20070829012203.B00D783049@common-lisp.net> Update of /project/oct/cvsroot/oct In directory clnet:/tmp/cvs-serv14357 Modified Files: qd-methods.lisp qd-package.lisp Log Message: qd-package.lisp: o Shadow FLOAT-DIGITS qd-methods.lisp: o Add FLOAT-DIGITS method. --- /project/oct/cvsroot/oct/qd-methods.lisp 2007/08/27 17:49:19 1.49 +++ /project/oct/cvsroot/oct/qd-methods.lisp 2007/08/29 01:22:03 1.50 @@ -806,6 +806,13 @@ (defmethod random ((x qd-real) &optional (state *random-state*)) (* x (make-instance 'qd-real :value (qdi:random-qd state)))) + +(defmethod float-digits ((x cl:real)) + (cl:float-digits x)) + +(defmethod float-digits ((x qd-real)) + (* 4 (float-digits 1d0))) + (define-compiler-macro + (&whole form &rest args) (if (null args) --- /project/oct/cvsroot/oct/qd-package.lisp 2007/08/28 16:01:08 1.35 +++ /project/oct/cvsroot/oct/qd-package.lisp 2007/08/29 01:22:03 1.36 @@ -162,6 +162,7 @@ #:numberp #:incf #:decf + #:float-digits ) (:export #:+ #:- @@ -225,6 +226,7 @@ #:numberp #:incf #:decf + #:float-digits ) ;; Constants (:export #:+pi+) From rtoy at common-lisp.net Wed Aug 29 14:22:42 2007 From: rtoy at common-lisp.net (rtoy) Date: Wed, 29 Aug 2007 10:22:42 -0400 (EDT) Subject: [oct-cvs] Oct commit: oct qd-methods.lisp Message-ID: <20070829142242.9457B30033@common-lisp.net> Update of /project/oct/cvsroot/oct In directory clnet:/tmp/cvs-serv14024 Modified Files: qd-methods.lisp Log Message: Forgot to handle comparisons of QD-COMPLEX and another number. --- /project/oct/cvsroot/oct/qd-methods.lisp 2007/08/29 01:22:03 1.50 +++ /project/oct/cvsroot/oct/qd-methods.lisp 2007/08/29 14:22:42 1.51 @@ -328,9 +328,17 @@ (defmethod ,method ((a qd-real) (b real)) (,qd-fun (qd-value a) (make-qd-d (cl:float b 1d0)))) (defmethod ,method ((a real) (b qd-real)) + ;; This is not really right if A is a rational. We're + ;; supposed to compare them as rationals. (,qd-fun (make-qd-d (cl:float a 1d0)) (qd-value b))) (defmethod ,method ((a qd-real) (b qd-real)) (,qd-fun (qd-value a) (qd-value b))) + (defmethod ,method ((a qd-complex) b) + (and (,method (realpart a) (realpart b)) + (,method (imagpart a) (imagpart b)))) + (defmethod ,method (a (b qd-complex)) + (and (,method (realpart a) (realpart b)) + (,method (imagpart a) (imagpart b)))) (defun ,op (number &rest more-numbers) "Returns T if its arguments are in strictly increasing order, NIL otherwise." (declare (optimize (safety 2)) @@ -345,18 +353,22 @@ (frob <=) (frob >=)) -(macrolet ((frob (name) - (let ((method-name (intern (concatenate 'string "Q" (symbol-name name)))) - (cl-name (intern (symbol-name name) :cl)) - (qd-name (intern (concatenate 'string (symbol-name name) "-QD")))) - `(progn - (defmethod ,method-name ((x number)) - (,cl-name x)) - (defmethod ,method-name ((x qd-real)) - (make-instance 'qd-real :value (,qd-name (qd-value x)))) - (declaim (inline ,name)) - (defun ,name (x) - (,method-name x)))))) +;; Handle the special functions for a real argument. Complex args are +;; handled elsewhere. +(macrolet + ((frob (name) + (let ((method-name + (intern (concatenate 'string "Q" (symbol-name name)))) + (cl-name (intern (symbol-name name) :cl)) + (qd-name (intern (concatenate 'string (symbol-name name) "-QD")))) + `(progn + (defmethod ,method-name ((x number)) + (,cl-name x)) + (defmethod ,method-name ((x qd-real)) + (make-instance 'qd-real :value (,qd-name (qd-value x)))) + (declaim (inline ,name)) + (defun ,name (x) + (,method-name x)))))) (frob abs) (frob exp) (frob sin) @@ -496,12 +508,14 @@ (defmethod two-arg-= ((a number) (b number)) (cl:= a b)) + (defmethod two-arg-= ((a qd-real) (b number)) - (if (realp b) + (if (cl:realp b) (qd-= (qd-value a) (make-qd-d (cl:float b 1d0))) nil)) + (defmethod two-arg-= ((a number) (b qd-real)) - (if (realp a) + (if (cl:realp a) (qd-= (make-qd-d (cl:float a 1d0)) (qd-value b)) nil)) From rtoy at common-lisp.net Wed Aug 29 14:37:20 2007 From: rtoy at common-lisp.net (rtoy) Date: Wed, 29 Aug 2007 10:37:20 -0400 (EDT) Subject: [oct-cvs] Oct commit: oct qd-methods.lisp Message-ID: <20070829143720.63ECC3700E@common-lisp.net> Update of /project/oct/cvsroot/oct In directory clnet:/tmp/cvs-serv15798 Modified Files: qd-methods.lisp Log Message: Oops. Last change went to the wrong spot. Only valid for =. --- /project/oct/cvsroot/oct/qd-methods.lisp 2007/08/29 14:22:42 1.51 +++ /project/oct/cvsroot/oct/qd-methods.lisp 2007/08/29 14:37:20 1.52 @@ -333,12 +333,6 @@ (,qd-fun (make-qd-d (cl:float a 1d0)) (qd-value b))) (defmethod ,method ((a qd-real) (b qd-real)) (,qd-fun (qd-value a) (qd-value b))) - (defmethod ,method ((a qd-complex) b) - (and (,method (realpart a) (realpart b)) - (,method (imagpart a) (imagpart b)))) - (defmethod ,method (a (b qd-complex)) - (and (,method (realpart a) (realpart b)) - (,method (imagpart a) (imagpart b)))) (defun ,op (number &rest more-numbers) "Returns T if its arguments are in strictly increasing order, NIL otherwise." (declare (optimize (safety 2)) @@ -519,6 +513,15 @@ (qd-= (make-qd-d (cl:float a 1d0)) (qd-value b)) nil)) +(defmethod two-arg-= ((a qd-complex) b) + (and (two-arg-= (realpart a) (realpart b)) + (two-arg-= (imagpart a) (imagpart b)))) + +(defmethod two-arg-= (a (b qd-complex)) + (and (two-arg-= (realpart a) (realpart b)) + (two-arg-= (imagpart a) (imagpart b)))) + + (defmethod two-arg-= ((a qd-real) (b qd-real)) (qd-= (qd-value a) (qd-value b))) From rtoy at common-lisp.net Wed Aug 29 14:37:42 2007 From: rtoy at common-lisp.net (rtoy) Date: Wed, 29 Aug 2007 10:37:42 -0400 (EDT) Subject: [oct-cvs] Oct commit: oct qd-format.lisp Message-ID: <20070829143742.919B03700F@common-lisp.net> Update of /project/oct/cvsroot/oct In directory clnet:/tmp/cvs-serv15853 Modified Files: qd-format.lisp Log Message: Add CL package qualifier for DECF and INCF. --- /project/oct/cvsroot/oct/qd-format.lisp 2007/08/27 17:49:19 1.5 +++ /project/oct/cvsroot/oct/qd-format.lisp 2007/08/29 14:37:42 1.6 @@ -73,7 +73,7 @@ (qdi::qd-to-string (qd-value num) spaceleft fdig k fmin) (when (and d (zerop d)) (setq tpoint nil)) (when w - (decf spaceleft flen) + (cl:decf spaceleft flen) ;; See CLHS 22.3.3.2. "If the parameter d is ;; omitted, ... [and] if the fraction to be ;; printed is zero then a single zero digit should @@ -82,10 +82,10 @@ ;; add an extra 0 digit later. (when (and (null d) (char= (aref fstr (1- flen)) #\.)) (setf add-zero-p t) - (decf spaceleft)) + (cl:decf spaceleft)) (when lpoint (if (or (> spaceleft 0) tpoint) - (decf spaceleft) + (cl:decf spaceleft) (setq lpoint nil))) (when (and tpoint (<= spaceleft 0)) (setq tpoint nil))) From rtoy at common-lisp.net Thu Aug 30 23:41:10 2007 From: rtoy at common-lisp.net (rtoy) Date: Thu, 30 Aug 2007 19:41:10 -0400 (EDT) Subject: [oct-cvs] Oct commit: oct qd-class.lisp Message-ID: <20070830234110.025876825E@common-lisp.net> Update of /project/oct/cvsroot/oct In directory clnet:/tmp/cvs-serv12848 Modified Files: qd-class.lisp Log Message: Change QD-COMPLEX printer to split the real and imaginary parts onto separate lines if necessary. --- /project/oct/cvsroot/oct/qd-class.lisp 2007/08/27 19:12:22 1.22 +++ /project/oct/cvsroot/oct/qd-class.lisp 2007/08/30 23:41:10 1.23 @@ -67,10 +67,11 @@ (make-instance 'qd-real :value (qd-value x))) (defmethod print-object ((qd qd-complex) stream) - (format stream "#q(~/qdi::qd-format/ ~/qdi::qd-format/)" - (qd-real qd) - (qd-imag qd))) + (format stream "#q(~<~/qdi::qd-format/ ~/qdi::qd-format/~:@>)" + (list (qd-real qd) + (qd-imag qd)))) +#+(or) (defmethod print-object ((qd qd-complex) stream) (write-string "#q(" stream) (print-qd (qd-real qd) stream) From rtoy at common-lisp.net Thu Aug 30 23:42:24 2007 From: rtoy at common-lisp.net (rtoy) Date: Thu, 30 Aug 2007 19:42:24 -0400 (EDT) Subject: [oct-cvs] Oct commit: oct qd-complex.lisp Message-ID: <20070830234224.1CB4D6A02E@common-lisp.net> Update of /project/oct/cvsroot/oct In directory clnet:/tmp/cvs-serv12895 Modified Files: qd-complex.lisp Log Message: Add methods to handle QD-REAL and CL:COMPLEX and vice-versa for the four basic arithmetic operations. --- /project/oct/cvsroot/oct/qd-complex.lisp 2007/08/28 16:01:08 1.32 +++ /project/oct/cvsroot/oct/qd-complex.lisp 2007/08/30 23:42:24 1.33 @@ -213,6 +213,39 @@ (complex (/ (+ (* rx r) ix) dn) (/ (- (* ix r) rx) dn)))))) +(defmethod two-arg-+ ((a qd-real) (b cl:complex)) + (complex (+ a (realpart b)) + (imagpart b))) + +(defmethod two-arg-+ ((a cl:complex) (b qd-real)) + (complex (+ (realpart a) b) + (imagpart a))) + +(defmethod two-arg-- ((a qd-real) (b cl:complex)) + (complex (- a (realpart b)) + (- (imagpart b)))) + +(defmethod two-arg-- ((a cl:complex) (b qd-real)) + (complex (- (realpart a) b) + (imagpart a))) + +(defmethod two-arg-* ((a qd-real) (b cl:complex)) + (complex (* a (realpart b)) + (* a (imagpart b)))) + +(defmethod two-arg-* ((a cl:complex) (b qd-real)) + (complex (* (realpart a) b) + (* (imagpart a) b))) + + +(defmethod two-arg-/ ((a qd-real) (b cl:complex)) + (two-arg-/ a (coerce b 'qd-complex))) + +(defmethod two-arg-/ ((a cl:complex) (b qd-real)) + (complex (/ (realpart a) b) + (/ (imagpart a) b))) + + (defmethod unary-divide ((a qd-complex)) (two-arg-/ #q1 a)) From rtoy at common-lisp.net Fri Aug 31 03:11:00 2007 From: rtoy at common-lisp.net (rtoy) Date: Thu, 30 Aug 2007 23:11:00 -0400 (EDT) Subject: [oct-cvs] Oct commit: oct qd-complex.lisp qd-methods.lisp Message-ID: <20070831031100.8D9CA481B4@common-lisp.net> Update of /project/oct/cvsroot/oct In directory clnet:/tmp/cvs-serv9259 Modified Files: qd-complex.lisp qd-methods.lisp Log Message: Get rid of the extra layer of function calls and define the special functions as methods directly. --- /project/oct/cvsroot/oct/qd-complex.lisp 2007/08/30 23:42:24 1.33 +++ /project/oct/cvsroot/oct/qd-complex.lisp 2007/08/31 03:11:00 1.34 @@ -668,69 +668,69 @@ (- (realpart result))))) ;; End of implementation of complex functions from CMUCL. -(defmethod qasin ((x qd-complex)) +(defmethod asin ((x qd-complex)) (qd-complex-asin x)) -(defmethod qacos ((x qd-complex)) +(defmethod acos ((x qd-complex)) (qd-complex-acos x)) -(defmethod qacosh ((x qd-complex)) +(defmethod acosh ((x qd-complex)) (qd-complex-acosh x)) -(defmethod qatanh ((x qd-complex)) +(defmethod atanh ((x qd-complex)) (qd-complex-atanh x)) -(defmethod qsin ((z qd-complex)) +(defmethod sin ((z qd-complex)) (let ((x (realpart z)) (y (imagpart z))) (complex (* (sin x) (cosh y)) (* (cos x) (sinh y))))) -(defmethod qcos ((z qd-complex)) +(defmethod cos ((z qd-complex)) (let ((x (realpart z)) (y (imagpart z))) (complex (* (cos x) (cosh y)) (- (* (sin x) (sinh y)))))) -(defmethod qtan ((z qd-complex)) +(defmethod tan ((z qd-complex)) (qd-complex-tan z)) -(defmethod qsinh ((z qd-complex)) +(defmethod sinh ((z qd-complex)) (let ((x (realpart z)) (y (imagpart z))) (complex (* (sinh x) (cos y)) (* (cosh x) (sin y))))) -(defmethod qcosh ((z qd-complex)) +(defmethod cosh ((z qd-complex)) (let ((x (realpart z)) (y (imagpart z))) (complex (* (cosh x) (cos y)) (* (sinh x) (sin y))))) -(defmethod qtanh ((z qd-complex)) +(defmethod tanh ((z qd-complex)) (qd-complex-tanh z)) -(defmethod qsqrt ((z qd-complex)) +(defmethod sqrt ((z qd-complex)) (qd-complex-sqrt z)) -(defmethod qatan ((y qd-complex) &optional x) +(defmethod atan ((y qd-complex) &optional x) (if x (error "First arg of 2-arg ATAN must be real") (qd-complex-atan y))) -(defmethod qatan ((y cl:complex) &optional x) +(defmethod atan ((y cl:complex) &optional x) (if x (error "First arg of 2-arg ATAN must be real") (cl:atan y))) -(defmethod qexp ((z qd-complex)) +(defmethod exp ((z qd-complex)) (let* ((x (realpart z)) (y (imagpart z)) (ex (exp x))) (complex (* ex (cos y)) (* ex (sin y))))) -(defmethod qlog ((a qd-complex) &optional b) +(defmethod log ((a qd-complex) &optional b) (if b (/ (qlog a) (qlog b)) (complex (log (abs a)) @@ -745,7 +745,7 @@ (defmethod qexpt ((x qd-complex) (y qd-complex)) (exp (* y (log x)))) -(defmethod qphase ((z qd-complex)) +(defmethod phase ((z qd-complex)) (atan (imagpart z) (realpart z))) (defun realp (x) --- /project/oct/cvsroot/oct/qd-methods.lisp 2007/08/29 14:37:20 1.52 +++ /project/oct/cvsroot/oct/qd-methods.lisp 2007/08/31 03:11:00 1.53 @@ -356,13 +356,10 @@ (cl-name (intern (symbol-name name) :cl)) (qd-name (intern (concatenate 'string (symbol-name name) "-QD")))) `(progn - (defmethod ,method-name ((x number)) + (defmethod ,name ((x number)) (,cl-name x)) - (defmethod ,method-name ((x qd-real)) - (make-instance 'qd-real :value (,qd-name (qd-value x)))) - (declaim (inline ,name)) - (defun ,name (x) - (,method-name x)))))) + (defmethod ,name ((x qd-real)) + (make-instance 'qd-real :value (,qd-name (qd-value x)))))))) (frob abs) (frob exp) (frob sin) @@ -378,19 +375,16 @@ ;;(frob atanh) ) -(defmethod qsqrt ((x number)) +(defmethod sqrt ((x number)) (cl:sqrt x)) -(defmethod qsqrt ((x qd-real)) +(defmethod sqrt ((x qd-real)) (if (minusp x) (make-instance 'qd-complex :real +qd-zero+ :imag (sqrt-qd (neg-qd (qd-value x)))) (make-instance 'qd-real :value (sqrt-qd (qd-value x))))) -(defun sqrt (x) - (qsqrt x)) - (defun scalb (x n) "Compute 2^N * X without compute 2^N first (use properties of the underlying floating-point format" @@ -422,12 +416,12 @@ :value (hypot-qd (qd-value (realpart z)) (qd-value (imagpart z))))) -(defmethod qlog ((a number) &optional b) +(defmethod log ((a number) &optional b) (if b (cl:log a b) (cl:log a))) -(defmethod qlog ((a qd-real) &optional b) +(defmethod log ((a qd-real) &optional b) (if b (/ (qlog a) (qlog b)) (if (minusp (float-sign a)) @@ -436,15 +430,10 @@ :imag +qd-pi+) (make-instance 'qd-real :value (log-qd (qd-value a)))))) -(declaim (inline log)) -(defun log (a &optional b) - (qlog a b)) - - (defmethod log1p ((a qd-real)) (make-instance 'qd-real :value (log1p-qd (qd-value a)))) -(defmethod qatan ((y real) &optional x) +(defmethod atan ((y real) &optional x) (cond (x (cond ((typep x 'qd-real) (make-instance 'qd-real @@ -454,17 +443,13 @@ (t (cl:atan y)))) -(defmethod qatan ((y qd-real) &optional x) +(defmethod atan ((y qd-real) &optional x) (make-instance 'qd-real :value (if x (atan2-qd (qd-value y) (qd-value x)) (atan-qd (qd-value y))))) -(defun atan (y &optional x) - (qatan y x)) - - (defmethod qexpt ((x number) (y number)) (cl:expt x y)) @@ -732,83 +717,57 @@ (if (< (car nlist) result) (setq result (car nlist))))) -(defmethod qasin ((x number)) +(defmethod asin ((x number)) (cl:asin x)) -(defmethod qasin ((x qd-real)) +(defmethod asin ((x qd-real)) (if (<= -1 x 1) (make-instance 'qd-real :value (asin-qd (qd-value x))) (qd-complex-asin x))) -(declaim (inline asin)) -(defun asin (x) - (qasin x)) - -(defmethod qacos ((x number)) +(defmethod acos ((x number)) (cl:acos x)) -(defmethod qacos ((x qd-real)) +(defmethod acos ((x qd-real)) (cond ((> (abs x) 1) (qd-complex-acos x)) (t (make-instance 'qd-real :value (acos-qd (qd-value x)))))) -(declaim (inline acos)) -(defun acos (x) - (qacos x)) - -(defmethod qacosh ((x number)) +(defmethod acosh ((x number)) (cl:acosh x)) -(defmethod qacosh ((x qd-real)) +(defmethod acosh ((x qd-real)) (if (< x 1) (qd-complex-acosh x) (make-instance 'qd-real :value (acosh-qd (qd-value x))))) - -(declaim (inline acosh)) -(defun acosh (x) - (qacosh x)) - -(defmethod qatanh ((x number)) +(defmethod atanh ((x number)) (cl:atanh x)) -(defmethod qatanh ((x qd-real)) +(defmethod atanh ((x qd-real)) (if (> (abs x) 1) (qd-complex-atanh x) (make-instance 'qd-real :value (atanh-qd (qd-value x))))) - -(declaim (inline atanh)) -(defun atanh (x) - (qatanh x)) - -(defmethod qcis ((x real)) +(defmethod cis ((x real)) (cl:cis x)) -(defmethod qcis ((x qd-real)) +(defmethod cis ((x qd-real)) (multiple-value-bind (s c) (sincos-qd (qd-value x)) (make-instance 'qd-complex :real c :imag s))) -(declaim (inline cis)) -(defun cis (x) - (qcis x)) - -(defmethod qphase ((x number)) +(defmethod phase ((x number)) (cl:phase x)) -(defmethod qphase ((x qd-real)) +(defmethod phase ((x qd-real)) (if (minusp x) (- +pi+) (make-instance 'qd-real :value (make-qd-d 0d0)))) -(declaim (inline phase)) -(defun phase (x) - (qphase x)) - (defun signum (number) "If NUMBER is zero, return NUMBER, else return (/ NUMBER (ABS NUMBER))." (if (zerop number) From rtoy at common-lisp.net Fri Aug 31 19:34:01 2007 From: rtoy at common-lisp.net (rtoy) Date: Fri, 31 Aug 2007 15:34:01 -0400 (EDT) Subject: [oct-cvs] Oct commit: oct qd-methods.lisp Message-ID: <20070831193401.19DD533081@common-lisp.net> Update of /project/oct/cvsroot/oct In directory clnet:/tmp/cvs-serv2308 Modified Files: qd-methods.lisp Log Message: Oops. Forgot to convert qabs to abs. --- /project/oct/cvsroot/oct/qd-methods.lisp 2007/08/31 03:11:00 1.53 +++ /project/oct/cvsroot/oct/qd-methods.lisp 2007/08/31 19:34:00 1.54 @@ -409,7 +409,7 @@ (scale-float (make-instance 'qd-real :value (sqrt abs^2)) rho))) -(defmethod qabs ((z qd-complex)) +(defmethod abs ((z qd-complex)) ;; sqrt(x^2+y^2) ;; If |x| > |y| then sqrt(x^2+y^2) = |x|*sqrt(1+(y/x)^2) (make-instance 'qd-real From rtoy at common-lisp.net Fri Aug 31 21:13:36 2007 From: rtoy at common-lisp.net (rtoy) Date: Fri, 31 Aug 2007 17:13:36 -0400 (EDT) Subject: [oct-cvs] Oct commit: oct qd-class.lisp qd-complex.lisp qd-methods.lisp Message-ID: <20070831211336.B07DC33086@common-lisp.net> Update of /project/oct/cvsroot/oct In directory clnet:/tmp/cvs-serv16229 Modified Files: qd-class.lisp qd-complex.lisp qd-methods.lisp Log Message: qd-class.lisp: o Oops. Forgot to rename the defgenerics. qd-complex.lisp: o QLOG no longer exists. Use LOG. qd-methods.lisp: o QLOG no longer exists. Use LOG. --- /project/oct/cvsroot/oct/qd-class.lisp 2007/08/30 23:41:10 1.23 +++ /project/oct/cvsroot/oct/qd-class.lisp 2007/08/31 21:13:36 1.24 @@ -173,40 +173,40 @@ (defgeneric qscale-float (x n) (:documentation "Multiply the float X by 2^N")) -(defgeneric qabs (x) +(defgeneric abs (x) (:documentation "Absolute value of X")) -(defgeneric qexp (x) +(defgeneric exp (x) (:documentation "Exponential of X")) -(defgeneric qsin (x) +(defgeneric sin (x) (:documentation "Sine of X")) -(defgeneric qcos (x) +(defgeneric cos (x) (:documentation "Cosine of X")) -(defgeneric qtan (x) +(defgeneric tan (x) (:documentation "Tangent of X")) -(defgeneric qsinh (x) +(defgeneric sinh (x) (:documentation "Hyperbolic sine of X")) -(defgeneric qcosh (x) +(defgeneric cosh (x) (:documentation "Hyperbolic cosine of X")) -(defgeneric qtanh (x) +(defgeneric tanh (x) (:documentation "Hyperbolic tangent of X")) -(defgeneric qsqrt (x) +(defgeneric sqrt (x) (:documentation "Square root of X")) -(defgeneric qlog (a &optional b) +(defgeneric log (a &optional b) (:documentation "Log of A base B. If B not given, then natural log")) (defgeneric log1p (x) (:documentation "log(1+x)")) -(defgeneric qatan (y &optional x) +(defgeneric atan (y &optional x) (:documentation "If X not given, atan(y). If X is given, atan(y/x), taking the quadrant into account")) @@ -231,22 +231,22 @@ (defgeneric qfloat-sign (a &optional b) (:documentation "Transfer sign of A to B. If B not given, assume 1")) -(defgeneric qasin (x) +(defgeneric asin (x) (:documentation "Inverse sine of X")) -(defgeneric qacos (x) +(defgeneric acos (x) (:documentation "Inverse cosine of X")) -(defgeneric qacosh (x) +(defgeneric acosh (x) (:documentation "Inverse hyperbolic cosine of X")) -(defgeneric qatanh (x) +(defgeneric atanh (x) (:documentation "Inverse hyperbolic tangent of X")) -(defgeneric qcis (x) +(defgeneric cis (x) (:documentation "(complex (cos x) (sin x))")) -(defgeneric qphase (x) +(defgeneric phase (x) (:documentation "Phase of X")) (defgeneric coerce (x type) --- /project/oct/cvsroot/oct/qd-complex.lisp 2007/08/31 03:11:00 1.34 +++ /project/oct/cvsroot/oct/qd-complex.lisp 2007/08/31 21:13:36 1.35 @@ -732,7 +732,7 @@ (defmethod log ((a qd-complex) &optional b) (if b - (/ (qlog a) (qlog b)) + (/ (log a) (log b)) (complex (log (abs a)) (atan (imagpart a) (realpart a))))) --- /project/oct/cvsroot/oct/qd-methods.lisp 2007/08/31 19:34:00 1.54 +++ /project/oct/cvsroot/oct/qd-methods.lisp 2007/08/31 21:13:36 1.55 @@ -423,7 +423,7 @@ (defmethod log ((a qd-real) &optional b) (if b - (/ (qlog a) (qlog b)) + (/ (log a) (log b)) (if (minusp (float-sign a)) (make-instance 'qd-complex :real (log-qd (abs-qd (qd-value a)))