├── Autoload └── _autoidx.lsp ├── COPYING ├── Data ├── absorbtion.lsp ├── aircraft.lsp ├── book.lsp ├── car-prices.lsp ├── diabetes.lsp ├── heating.lsp ├── iris.lsp ├── leukemia.lsp ├── metabolism.lsp ├── oxygen.lsp ├── puromycin.lsp ├── randu.lsp ├── stackloss.lsp └── tutorial.lsp ├── Examples ├── abrasiondemo.lsp ├── addbox.lsp ├── addhandrotate.lsp ├── bcdemo.lsp ├── dataprotos.lsp ├── fstat.lsp ├── inspect.lsp ├── plotcontrols.lsp ├── regdemo.lsp ├── rotatedemo.lsp ├── tour.lsp └── tourdemo.lsp ├── Extras ├── regexp │ ├── Makefile.in │ ├── README │ ├── _autoidx.lsp │ ├── configure │ ├── configure.in │ ├── makefile.bc │ ├── makefile.vc │ ├── regex │ │ ├── COPYRIGHT │ │ ├── Makefile │ │ ├── WHATSNEW │ │ ├── cclass.h │ │ ├── cname.h │ │ ├── engine.c │ │ ├── re_format.7 │ │ ├── regcomp.c │ │ ├── regerror.c │ │ ├── regex.3 │ │ ├── regex.h │ │ ├── regex2.h │ │ ├── regexec.c │ │ ├── regfree.c │ │ └── utils.h │ ├── regexp.def │ ├── regexp.exp │ ├── regexp.wrp │ ├── rtest.c │ ├── sys%2ftypes.h │ └── vcregexp.def ├── sockets │ ├── Makefile.in │ ├── README │ ├── _autoidx.lsp │ ├── configure │ ├── configure.in │ ├── echoserv.c │ ├── echotest.c │ ├── makefile.bc │ ├── makefile.vc │ ├── sock.c │ ├── sock.h │ ├── sock.lsp │ ├── socktest.lsp │ ├── vcxlsock.def │ ├── xlsock.c │ ├── xlsock.def │ └── xlsock.exp └── wrappers │ ├── Makefile.in │ ├── README │ ├── _autoidx.lsp │ ├── configure │ ├── configure.in │ ├── makefile.bc │ ├── wrap.lsp │ ├── wrapptrs.def │ ├── wrapptrs.exp │ ├── wrapptrs.mu.sit.hqx │ └── wrapptrs.wrp ├── INSTALL ├── Makefile.in ├── README ├── aclocal.m4 ├── config ├── config.guess ├── config.sub └── install-sh ├── configure ├── configure.in ├── doc ├── README ├── changes.ind ├── changes.tex ├── glim.tex ├── xlispdoc.ps ├── xlispdoc.txt └── xlispins.doc ├── emacs ├── README.exls ├── exls ├── my.emacs ├── xlispstat.el └── xlispstat19.el ├── setup.shell ├── shlibconfig.sh.in ├── src ├── c │ ├── Makefile.in │ ├── X11BSDstuff.c │ ├── X11buttons.c │ ├── X11choice.c │ ├── X11dialogs.c │ ├── X11graph.c │ ├── X11listitem.c │ ├── X11menus.c │ ├── X11resizebr.c │ ├── X11scroll.c │ ├── X11slider.c │ ├── X11text.c │ ├── X11toggle.c │ ├── basics.c │ ├── betab.c │ ├── bivnor.c │ ├── blas.c │ ├── cfft.c │ ├── cholesky.c │ ├── common.c │ ├── compound.c │ ├── ddists.c │ ├── dialogs.c │ ├── dists.c │ ├── dummycod.c │ ├── dummygraph.c │ ├── eigen.c │ ├── foo.c │ ├── gamln.c │ ├── gammab.c │ ├── graphics.c │ ├── hrdwrobs.c │ ├── iview.c │ ├── iviewdat.c │ ├── iviewint.c │ ├── iviewscl.c │ ├── kernel.c │ ├── linalg.c │ ├── lowess.c │ ├── ludecomp.c │ ├── machines │ │ ├── README │ │ ├── aix │ │ │ ├── README │ │ │ ├── dynload │ │ │ │ ├── Makefile │ │ │ │ ├── README │ │ │ │ ├── dl.exp │ │ │ │ ├── dlfcn.c │ │ │ │ └── dlfcn.h │ │ │ ├── foo.exp │ │ │ └── xlisp.exp │ │ ├── alpha │ │ │ └── README │ │ ├── cray │ │ │ └── README │ │ ├── decstation │ │ │ └── README │ │ ├── encore │ │ │ └── README │ │ ├── epix │ │ │ ├── README │ │ │ └── isnan.c │ │ ├── generic │ │ │ └── README │ │ ├── hpux │ │ │ ├── README │ │ │ └── dlfcn │ │ │ │ ├── dlfcn.c │ │ │ │ └── dlfcn.h │ │ ├── ibmrt_bsd │ │ │ ├── README │ │ │ ├── foreign.h │ │ │ └── xsdynload.patch │ │ ├── irix │ │ │ └── README │ │ ├── linux │ │ │ └── README │ │ ├── pmax │ │ │ ├── README │ │ │ └── StX11options.h │ │ ├── solaris │ │ │ └── README │ │ ├── sunos3 │ │ │ └── README │ │ ├── sunos4 │ │ │ └── README │ │ └── vax │ │ │ └── README │ ├── macintosh │ │ ├── CWHeader.h │ │ ├── FakeAlert1.c │ │ ├── MakeXLSDistribution │ │ ├── README │ │ ├── README.mac │ │ ├── TransEdit1.c │ │ ├── TransEdit1.h │ │ ├── TransSkel1.c │ │ ├── TransSkel1.h │ │ ├── XLISP-STAT.make.hqx │ │ ├── XLISP-STAT.proj.hqx │ │ ├── XLISP.proj.Rsrc.hqx │ │ ├── XLS.proj.rsrc.sit.hqx │ │ ├── XLS68K020.mcp.xml │ │ ├── XLS68K881.mcp.xml │ │ ├── XLS68KGEN.mcp.xml │ │ ├── XLSPPC.mcp.xml │ │ ├── dirent.c │ │ ├── dirent.h │ │ ├── dlfcn.c │ │ ├── dlfcn.h │ │ ├── edit.c │ │ ├── editwindows.c │ │ ├── macdialogs1.c │ │ ├── macdialogs2.c │ │ ├── macdynload.c │ │ ├── maciviewwindow.c │ │ ├── maciviewwindow2.c │ │ ├── maciviewwindow3.c │ │ ├── macmenus.c │ │ ├── macresizebrush.c │ │ ├── macstuff.c │ │ ├── macutils.c │ │ ├── macutils.h │ │ ├── macwindows.c │ │ ├── macxsgraph.c │ │ ├── sys_dirent.h │ │ ├── xlconfig.h │ │ └── xlsx.h │ ├── makerot.c │ ├── math.c │ ├── mats1.c │ ├── mats2.c │ ├── menus.c │ ├── minimize.c │ ├── mswin │ │ ├── README │ │ ├── README.win │ │ ├── config.lsp │ │ ├── cursors │ │ │ ├── brush.uu │ │ │ ├── finger.uu │ │ │ ├── gc.uu │ │ │ └── hand.uu │ │ ├── dlfcn.c │ │ ├── dlfcn.h │ │ ├── dllstub.c │ │ ├── dumpexts.c │ │ ├── filedlgs.c │ │ ├── icons │ │ │ ├── graph.uu │ │ │ ├── ledit.uu │ │ │ └── wxls.uu │ │ ├── ledit.c │ │ ├── ledit.h │ │ ├── lspedit │ │ │ ├── README │ │ │ ├── lspedit.c │ │ │ ├── lspedit.def │ │ │ ├── lspedit.h │ │ │ ├── lspedit.rc │ │ │ ├── makefile │ │ │ └── makefile.gnu │ │ ├── makedist │ │ ├── makefile │ │ ├── makefile.gnu │ │ ├── malloc.c │ │ ├── msstuff.c │ │ ├── mswalloc.c │ │ ├── mswdlg.c │ │ ├── mswdynld.c │ │ ├── mswgraph.c │ │ ├── mswmem.c │ │ ├── mswmenus.c │ │ ├── mswrszbr.c │ │ ├── mswstuff.c │ │ ├── mswwins.c │ │ ├── spp.c │ │ ├── statdum.c │ │ ├── winutils.c │ │ ├── winutils.h │ │ ├── wxlisp.c │ │ ├── wxlisp.h │ │ ├── wxls.def │ │ ├── wxls.rc │ │ ├── wxls.tex │ │ ├── wxls32.rc │ │ ├── xlconfig.h │ │ ├── xlsclient │ │ │ ├── makefile │ │ │ ├── makefile.gnu │ │ │ └── xlsclient.c │ │ ├── xlsx.c │ │ └── xlsx.h │ ├── myplot.c │ ├── nor.c │ ├── obinit.c │ ├── objects.c │ ├── optimize.c │ ├── postscript.c │ ├── ppnd.c │ ├── qrdecomp.c │ ├── sortdata.c │ ├── splines.c │ ├── statinit.c │ ├── stats.c │ ├── stmem.c │ ├── studentb.c │ ├── svdecomp.c │ ├── term.c │ ├── unixprim.c │ ├── unixstuff.c │ ├── utils.c │ ├── utils2.c │ ├── windows.c │ ├── xlarray.c │ ├── xlbcode.c │ ├── xlbcutil.c │ ├── xlbfun.c │ ├── xlbignum.c │ ├── xlcont.c │ ├── xldbug.c │ ├── xldmem.c │ ├── xleval.c │ ├── xlfio.c │ ├── xlftab.c │ ├── xlglob.c │ ├── xlimage.c │ ├── xlinit.c │ ├── xlio.c │ ├── xlisp.c │ ├── xljump.c │ ├── xllist.c │ ├── xlmath.c │ ├── xlmath2.c │ ├── xlmath3.c │ ├── xlmodule.c │ ├── xlobj.c │ ├── xlpp.c │ ├── xlprin.c │ ├── xlrand.c │ ├── xlread.c │ ├── xlseq.c │ ├── xlserv.c │ ├── xlshlib.c │ ├── xlstr.c │ ├── xlstruct.c │ ├── xlsubr.c │ ├── xlsym.c │ ├── xlsys.c │ ├── xltvec.c │ ├── xlwrap.c │ ├── xsdynload.c │ ├── xsgraph.c │ ├── xshist.c │ ├── xsiview.c │ ├── xsiview2.c │ ├── xsiview3.c │ ├── xsivint.c │ ├── xsivwin.c │ ├── xsivwin2.c │ ├── xsnames.c │ ├── xsnewplt.c │ ├── xssctmat.c │ ├── xssctplt.c │ ├── xsspin.c │ └── xssystem.c ├── include │ ├── StX11options.h │ ├── bsd-foreign.h │ ├── dialogs.h │ ├── dld-foreign.h │ ├── dummy-foreign.h │ ├── encore-foreign.h │ ├── epix-foreign.h │ ├── gnuplot.h │ ├── hpux-foreign.h │ ├── iview.h │ ├── linalg.h │ ├── osdefs.h │ ├── osptrs.h │ ├── pmax-foreign.h │ ├── sysvr4-foreign.h │ ├── version.h │ ├── xlbcode.h │ ├── xlconfig.h.in │ ├── xldmem.h │ ├── xlftab.h │ ├── xlglob.h │ ├── xlgraph.h │ ├── xlisp.h │ ├── xlmodule.h │ ├── xlshlib.h │ ├── xlstat.h │ └── xlwrap.h └── lsp │ ├── Makefile │ ├── bayes.lsp │ ├── cmpload.lsp │ ├── cmpsys.lsp │ ├── common.lsp │ ├── common2.lsp │ ├── common3.lsp │ ├── compiler │ ├── README │ ├── assemble.lsp │ ├── backquot.lsp │ ├── cells.lsp │ ├── cmpfront.lsp │ ├── cmpmacro.lsp │ ├── convert.lsp │ ├── gencode.lsp │ ├── lift.lsp │ ├── peephole.lsp │ └── simplify.lsp │ ├── conditns.lsp │ ├── dde.lsp │ ├── dialogs.lsp │ ├── glim.lsp │ ├── graph2.lsp │ ├── graph3.lsp │ ├── graphics.lsp │ ├── help.lsp │ ├── init.lsp │ ├── linalg.lsp │ ├── loadfsl.lsp │ ├── maximize.lsp │ ├── menus.lsp │ ├── nongraph.lsp │ ├── nonlin.lsp │ ├── objects.lsp │ ├── oldstep.lsp │ ├── oneway.lsp │ ├── pathname.lsp │ ├── regress.lsp │ ├── shlib.lsp │ ├── stats.lsp │ └── stepper.lsp ├── tests ├── README ├── arith.lsp ├── blas.lsp ├── complex.lsp ├── manip.lsp ├── math.lsp ├── matrix.lsp ├── matrix2.lsp ├── prob.lsp ├── rans.lsp ├── test.lsp └── trig.lsp ├── xlisp.hlp └── xlisponly ├── Makefile.in ├── README ├── cmplsp └── Makefile ├── compiler └── Makefile ├── configure ├── configure.in ├── lsp ├── ackerman.lsp ├── akalah.lsp ├── akavect.lsp ├── art.lsp ├── backquot.lsp ├── blocks.lsp ├── change.lsp ├── classes.lsp ├── clsdemo.lsp ├── cmpclasses.lsp ├── common.lsp ├── common2.lsp ├── document.lsp ├── dragon.lsp ├── edit.lsp ├── evalenv.lsp ├── example.bak ├── example.lsp ├── fact.lsp ├── fib.lsp ├── gblocks.lsp ├── glos.lsp ├── glos.txt ├── hanoi.lsp ├── hdwr.lsp ├── ifthen.lsp ├── infix.lsp ├── init.lsp ├── inspect.lsp ├── makewks.lsp ├── match.lsp ├── matrix.lsp ├── memo.lsp ├── pp.lsp ├── profile.lsp ├── prolog.lsp ├── qa.lsp ├── queens.lsp ├── queens2.lsp ├── rational.lsp ├── readme.lsp ├── repair.lsp ├── search.lsp ├── sendmacr.lsp ├── sort.lsp ├── step.lsp ├── stepper.doc ├── stepper.lsp ├── tak.lsp ├── tconc.lsp ├── turtle.lsp ├── turtles.lsp └── wildcard.lsp ├── sources ├── Makefile.in └── cmpload.lsp └── xlisp.sh /Autoload/_autoidx.lsp: -------------------------------------------------------------------------------- 1 | ;;;; XLISP-STAT 2.1 Copyright (c) 1990-1997, by Luke Tierney 2 | ;;;; Additions to Xlisp 2.1, Copyright (c) 1989 by David Michael Betz 3 | ;;;; You may give out copies of this software; for conditions see the file 4 | ;;;; COPYING included with this distribution. 5 | 6 | (in-package "USER") 7 | (system:define-autoload-module "nonlin" 8 | (variable nreg-model-proto) 9 | (function nreg-model)) 10 | 11 | (in-package "USER") 12 | (system:define-autoload-module "oneway" 13 | (variable oneway-model-proto) 14 | (function oneway-model)) 15 | 16 | (in-package "XLISP") 17 | (export '(numgrad numhess newtonmax nelmeadmax)) 18 | (system:define-autoload-module "maximize" 19 | (function numgrad numhess newtonmax nelmeadmax)) 20 | 21 | (in-package "USER") 22 | (system:define-autoload-module "bayes" 23 | (function bayes-model) 24 | (variable bayes-model-proto)) 25 | 26 | (in-package "XLISP") 27 | (export 'step) 28 | (system:define-autoload-module "stepper" 29 | (function step)) 30 | 31 | (in-package "XLISP") 32 | (export '(compile compile-file)) 33 | (system:define-autoload-module "cmpload" 34 | (function compile compile-file)) 35 | 36 | (in-package "USER") 37 | (system:define-autoload-module "glim" 38 | (variable glim-link-proto identity-link log-link inverse-link sqrt-link 39 | power-link-proto logit-link probit-link cloglog-link glim-proto 40 | normalreg-proto poissonreg-proto binomialreg-proto gammareg-proto) 41 | (function normalreg-model poissonreg-model loglinreg-model binomialreg-model 42 | logitreg-model probitreg-model gammareg-model indicators 43 | cross-terms level-names cross-names)) 44 | -------------------------------------------------------------------------------- /COPYING: -------------------------------------------------------------------------------- 1 | ****************************************************************************** 2 | * XLISP-STAT 2.1 Copyright (c) 1990, by Luke Tierney 3 | * XLISP version 2.1, Copyright (c) 1989, by David Betz. 4 | * 5 | * Permission to use, copy, modify, distribute, and sell this software and its 6 | * documentation for any purpose is hereby granted without fee, provided that 7 | * the above copyright notice appear in all copies and that both that 8 | * copyright notice and this permission notice appear in supporting 9 | * documentation, and that the name of Luke Tierney and David Betz not be 10 | * used in advertising or publicity pertaining to distribution of the software 11 | * without specific, written prior permission. Luke Tierney and David Betz 12 | * make no representations about the suitability of this software for any 13 | * purpose. It is provided "as is" without express or implied warranty. 14 | * 15 | * LUKE TIERNEY AND DAVID BETZ DISCLAIM ALL WARRANTIES WITH REGARD TO THIS 16 | * SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS, 17 | * IN NO EVENT SHALL LUKE TIERNEY NOR DAVID BETZ BE LIABLE FOR ANY SPECIAL, 18 | * INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM 19 | * LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE 20 | * OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR 21 | * PERFORMANCE OF THIS SOFTWARE. 22 | * 23 | * XLISP-STAT AUTHOR: 24 | * Luke Tierney 25 | * School of Statistics 26 | * University of Minnesota 27 | * Minneapolis, MN 55455 28 | * (612) 625-7843 29 | * 30 | * Email Address: 31 | * internet: luke@umnstat.stat.umn.edu 32 | * 33 | * XLISP AUTHOR: 34 | * David Betz 35 | * P.O. Box 144 36 | * Peterborough, NH 03458 37 | * (603) 924-4145 38 | ****************************************************************************** 39 | 40 | Acknowledgement for the MS Windows version (sprintf function): 41 | This product includes software developed by the University of California, 42 | Berkeley and its contributors. 43 | -------------------------------------------------------------------------------- /Data/absorbtion.lsp: -------------------------------------------------------------------------------- 1 | (def iron (list 61 175 111 124 130 173 169 169 160 224 257 333 199)) 2 | (def aluminum (list 13 21 24 23 64 38 33 61 39 71 112 88 54)) 3 | (def absorbtion (list 4 18 14 18 26 26 21 30 28 36 65 62 40)) 4 | -------------------------------------------------------------------------------- /Data/aircraft.lsp: -------------------------------------------------------------------------------- 1 | (require "maximize") 2 | 3 | (def failure-times 4 | '((413 14 58 37 100 65 9 169 447 184 36 201 118 34 31 5 | 18 18 67 57 62 7 22 34) 6 | (90 10 60 186 61 49 14 24 56 20 79 84 44 59 29 118 25 156 7 | 310 76 26 44 23 62 130 208 70 101 208) 8 | (74 57 48 29 502 12 70 21 29 386 59 27 153 26 326) 9 | (55 320 65 104 220 239 47 246 176 182 33 15 104 35) 10 | (23 261 87 7 120 14 62 47 225 71 246 21 42 20 5 12 120 11 | 11 3 14 71 11 14 11 16 90 1 16 52 95))) 12 | 13 | (def x (select failure-times 1)) 14 | 15 | (defun gllik (theta) 16 | (let* ((mu (select theta 0)) 17 | (beta (select theta 1)) 18 | (n (length x)) 19 | (bym (* x (/ beta mu)))) 20 | (+ (* n (- (log beta) (log mu) (log-gamma beta))) 21 | (sum (* (- beta 1) (log bym))) 22 | (sum (- bym))))) 23 | -------------------------------------------------------------------------------- /Data/car-prices.lsp: -------------------------------------------------------------------------------- 1 | (DEF CAR-PRICES (QUOTE (0.95 1.9 1.3 1.8 1.7 1.5 1.39 1.5 1.5 1.99 1.5 1.75 1.79 1.8 1.1 1.99 1.39 1.8 2.98 2.98 2.9 2.49 2.55 2.6 2.85 2 2.39 2.55 2 2.9 2.99 2.39 2.68 2.48 3.99 3.99 3.3 3.75 3.28 3.92 3.8 3.19 4.88 4.39 4.48 5.2 5.49 5.3 5.3 5.87))) 2 | -------------------------------------------------------------------------------- /Data/diabetes.lsp: -------------------------------------------------------------------------------- 1 | 2 | (DEF DIABETES (QUOTE ((80 97 105 90 90 86 100 85 97 97 91 87 78 90 86 80 90 99 85 90 90 88 95 90 92 74 98 100 86 98 70 99 75 90 85 99 100 78 106 98 102 90 94 80 93 86 85 96 88 87 94 93 86 86 96 86 89 83 98 100 110 88 100 80 89 91 96 95 82 84 90 100 86 93 107 112 94 93 93 90 99 93 85 89 96 111 107 114 101 108 112 105 103 99 102 110 102 96 95 112 110 92 104 75 92 92 92 93 112 88 114 103 300 303 125 280 216 190 151 303 173 203 195 140 151 275 260 149 233 146 124 213 330 123 130 120 138 188 339 265 353 180 213 328 346) (356 289 319 356 323 381 350 301 379 296 353 306 290 371 312 393 364 359 296 345 378 304 347 327 386 365 365 352 325 321 360 336 352 353 373 376 367 335 396 277 378 360 291 269 318 328 334 356 291 360 313 306 319 349 332 323 323 351 478 398 426 439 429 333 472 436 418 391 390 416 413 385 393 376 403 414 426 364 391 356 398 393 425 318 465 558 503 540 469 486 568 527 537 466 599 477 472 456 517 503 522 476 472 455 442 541 580 472 562 423 643 533 1468 1487 714 1470 1113 972 854 1364 832 967 920 613 857 1373 1133 849 1183 847 538 1001 1520 557 670 636 741 958 1354 1263 1428 923 1025 1246 1568) (124 117 143 199 240 157 221 186 142 131 221 178 136 200 208 202 152 185 116 123 136 134 184 192 279 228 145 172 179 222 134 143 169 263 174 134 182 241 128 222 165 282 94 121 73 106 118 112 157 292 200 220 144 109 151 158 73 81 151 122 117 208 201 131 162 148 130 137 375 146 344 192 115 195 267 281 213 156 221 199 76 490 143 73 237 748 320 188 607 297 232 480 622 287 266 124 297 326 564 408 325 433 180 392 109 313 132 285 139 212 155 120 28 23 232 54 81 87 76 42 102 138 160 131 145 45 118 159 73 103 460 42 13 130 44 314 219 100 10 83 41 77 29 124 15) (3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 2 3 3 2 2 3 2 2 3 3 3 3 2 3 3 3 3 3 2 3 3 3 3 3 2 3 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1)))) 3 | (DEF DLABS (QUOTE ("GLUFAST" "GLUTEST" "INSTEST" "CCLASS"))) -------------------------------------------------------------------------------- /Data/heating.lsp: -------------------------------------------------------------------------------- 1 | (DEF GAS-HEAT (QUOTE (25.42 26.12 25.22 23.6 27.77 28.52 21.6 29.49 26.22 25.52 20.19 23.99 26.32 23.38 26.77 31.56 25.54 22.72 27.58 29.96 26.2 23.97 28.17 18.01 22.98))) 2 | (DEF ELECTRIC-HEAT (QUOTE (33.52 51.01 41.99 33.8 25.93 30.32 32.06 39.86 24.62 31.8 48.58 44.65 31.3 35.4 19.24 40.78 43.39 34.78 25.43 33.82 26.47 34.62 32.02 27.98 30.92))) 3 | -------------------------------------------------------------------------------- /Data/iris.lsp: -------------------------------------------------------------------------------- 1 | (DEF VARNAMES (QUOTE ("Sepal Length" "Sepal Width" "Petal Length" "Petal Width"))) 2 | (DEF IRIS (QUOTE ((5.1 4.9 4.7 4.6 5 5.4 4.6 5 4.4 4.9 5.4 4.8 4.8 4.3 5.8 5.7 5.4 5.1 5.7 5.1 5.4 5.1 4.6 5.1 4.8 5 5 5.2 5.2 4.7 4.8 5.4 5.2 5.5 4.9 5 5.5 4.9 4.4 5.1 5 4.5 4.4 5 5.1 4.8 5.1 4.6 5.3 5 7 6.4 6.9 5.5 6.5 5.7 6.3 4.9 6.6 5.2 5 5.9 6 6.1 5.6 6.7 5.6 5.8 6.2 5.6 5.9 6.1 6.3 6.1 6.4 6.6 6.8 6.7 6 5.7 5.5 5.5 5.8 6 5.4 6 6.7 6.3 5.6 5.5 5.5 6.1 5.8 5 5.6 5.7 5.7 6.2 5.1 5.7 6.3 5.8 7.1 6.3 6.5 7.6 4.9 7.3 6.7 7.2 6.5 6.4 6.8 5.7 5.8 6.4 6.5 7.7 7.7 6 6.9 5.6 7.7 6.3 6.7 7.2 6.2 6.1 6.4 7.2 7.4 7.9 6.4 6.3 6.1 7.7 6.3 6.4 6 6.9 6.7 6.9 5.8 6.8 6.7 6.7 6.3 6.5 6.2 5.9) (3.5 3 3.2 3.1 3.6 3.9 3.4 3.4 2.9 3.1 3.7 3.4 3 3 4 4.4 3.9 3.5 3.8 3.8 3.4 3.7 3.6 3.3 3.4 3 3.4 3.5 3.4 3.2 3.1 3.4 4.1 4.2 3.1 3.2 3.5 3.6 3 3.4 3.5 2.3 3.2 3.5 3.8 3 3.8 3.2 3.7 3.3 3.2 3.2 3.1 2.3 2.8 2.8 3.3 2.4 2.9 2.7 2 3 2.2 2.9 2.9 3.1 3 2.7 2.2 2.5 3.2 2.8 2.5 2.8 2.9 3 2.8 3 2.9 2.6 2.4 2.4 2.7 2.7 3 3.4 3.1 2.3 3 2.5 2.6 3 2.6 2.3 2.7 3 2.9 2.9 2.5 2.8 3.3 2.7 3 2.9 3 3 2.5 2.9 2.5 3.6 3.2 2.7 3 2.5 2.8 3.2 3 3.8 2.6 2.2 3.2 2.8 2.8 2.7 3.3 3.2 2.8 3 2.8 3 2.8 3.8 2.8 2.8 2.6 3 3.4 3.1 3 3.1 3.1 3.1 2.7 3.2 3.3 3 2.5 3 3.4 3) (1.4 1.4 1.3 1.5 1.4 1.7 1.4 1.5 1.4 1.5 1.5 1.6 1.4 1.1 1.2 1.5 1.3 1.4 1.7 1.5 1.7 1.5 1 1.7 1.9 1.6 1.6 1.5 1.4 1.6 1.6 1.5 1.5 1.4 1.5 1.2 1.3 1.4 1.3 1.5 1.3 1.3 1.3 1.6 1.9 1.4 1.6 1.4 1.5 1.4 4.7 4.5 4.9 4 4.6 4.5 4.7 3.3 4.6 3.9 3.5 4.2 4 4.7 3.6 4.4 4.5 4.1 4.5 3.9 4.8 4 4.9 4.7 4.3 4.4 4.8 5 4.5 3.5 3.8 3.7 3.9 5.1 4.5 4.5 4.7 4.4 4.1 4 4.4 4.6 4 3.3 4.2 4.2 4.2 4.3 3 4.1 6 5.1 5.9 5.6 5.8 6.6 4.5 6.3 5.8 6.1 5.1 5.3 5.5 5 5.1 5.3 5.5 6.7 6.9 5 5.7 4.9 6.7 4.9 5.7 6 4.8 4.9 5.6 5.8 6.1 6.4 5.6 5.1 5.6 6.1 5.6 5.5 4.8 5.4 5.6 5.1 5.1 5.9 5.7 5.2 5 5.2 5.4 5.1) (0.2 0.2 0.2 0.2 0.2 0.4 0.3 0.2 0.2 0.1 0.2 0.2 0.1 0.1 0.2 0.4 0.4 0.3 0.3 0.3 0.2 0.4 0.2 0.5 0.2 0.2 0.4 0.2 0.2 0.2 0.2 0.4 0.1 0.2 0.2 0.2 0.2 0.1 0.2 0.2 0.3 0.3 0.2 0.6 0.4 0.3 0.2 0.2 0.2 0.2 1.4 1.5 1.5 1.3 1.5 1.3 1.6 1 1.3 1.4 1 1.5 1 1.4 1.3 1.4 1.5 1 1.5 1.1 1.8 1.3 1.5 1.2 1.3 1.4 1.4 1.7 1.5 1 1.1 1 1.2 1.6 1.5 1.6 1.5 1.3 1.3 1.3 1.2 1.4 1.2 1 1.3 1.2 1.3 1.3 1.1 1.3 2.5 1.9 2.1 1.8 2.2 2.1 1.7 1.8 1.8 2.5 2 1.9 2.1 2 2.4 2.3 1.8 2.2 2.3 1.5 2.3 2 2 1.8 2.1 1.8 1.8 1.8 2.1 1.6 1.9 2 2.2 1.5 1.4 2.3 2.4 1.8 1.8 2.1 2.4 2.3 1.9 2.3 2.5 2.3 1.9 2 2.3 1.8)))) 3 | -------------------------------------------------------------------------------- /Data/leukemia.lsp: -------------------------------------------------------------------------------- 1 | (require "bayes") 2 | 3 | (def wbc-pos (list 2300 750 4300 2600 6000 10500 10000 17000 5400 7000 4 | 9400 32000 35000 100000 100000 52000 100000)) 5 | 6 | (def transformed-wbc-pos (- (log wbc-pos) (log 10000))) 7 | 8 | (def times-pos (list 65 156 100 134 16 108 121 4 39 143 56 26 22 1 1 5 65)) 9 | 10 | (defun llik-pos (theta) 11 | (let* ((x transformed-wbc-pos) 12 | (y times-pos) 13 | (theta0 (select theta 0)) 14 | (theta1 (select theta 1)) 15 | (t1x (* theta1 x))) 16 | (- (sum t1x) 17 | (* (length x) (log theta0)) 18 | (/ (sum (* y (exp t1x))) 19 | theta0)))) 20 | 21 | (defun lk-sprob (theta) 22 | (let* ((time 52.0) 23 | (x (log 5)) 24 | (mu (* (select theta 0) (exp (- (* (select theta 1) x)))))) 25 | (exp (- (/ time mu))))) 26 | -------------------------------------------------------------------------------- /Data/metabolism.lsp: -------------------------------------------------------------------------------- 1 | (DEF CPK (QUOTE (180 300 520 480 580 440 380 480 520 1040 1360 640 260 360 400 230 300 400))) 2 | (DEF AGE (QUOTE (33 21 19 24 25 32 36 35 36 24 25 44 51 50 52 55 62 57))) 3 | -------------------------------------------------------------------------------- /Data/oxygen.lsp: -------------------------------------------------------------------------------- 1 | (def ethanol (list .59 .30 .25 .03 .44 .18 .13 .02 .22 .23 .07 .00 .12 .13 .00 .01)) 2 | (def oxygen (list 1 1 1 1 2 2 2 2 3 3 3 3 4 4 4 4)) 3 | (def sugar (list 1 1 2 2 1 1 2 2 1 1 2 2 1 1 2 2 )) 4 | 5 | -------------------------------------------------------------------------------- /Data/puromycin.lsp: -------------------------------------------------------------------------------- 1 | (require "nonlin") 2 | 3 | (def x1 (list 0.02 0.02 0.06 0.06 .11 .11 .22 .22 .56 .56 1.1 1.1)) 4 | 5 | (def x2 (list 0.02 0.02 0.06 0.06 .11 .11 .22 .22 .56 .56 1.1)) 6 | 7 | (def y1 (list 76 47 97 107 123 139 159 152 191 201 207 200)) 8 | 9 | (def y2 (list 67 51 84 86 98 115 131 124 144 158 160)) 10 | 11 | (defun f1 (theta) 12 | "The Michaelis-Menten function for the velocity of an enzymatic reaction 13 | as a function of the substrate concentration. THETA is a parameter 14 | vector of length 2 consisting of the asymptotic velocity and the 15 | concentration at which half the asymptotic velocity is attained." 16 | (/ (* (select theta 0) x1) (+ (select theta 1) x1))) 17 | 18 | (defun f2 (theta) 19 | "The Michaelis-Menten function for the velocity of an enzymatic reaction 20 | as a function of the substrate concentration. THETA is a parameter 21 | vector of length 2 consisting of the asymptotic velocity and the 22 | concentration at which half the asymptotic velocity is attained." 23 | (/ (* (select theta 0) x2) (+ (select theta 1) x2))) 24 | 25 | -------------------------------------------------------------------------------- /Data/stackloss.lsp: -------------------------------------------------------------------------------- 1 | (DEF LOSS (QUOTE (42 37 37 28 18 18 19 20 15 14 14 13 11 12 8 7 8 8 9 15 15))) 2 | (DEF AIR (QUOTE (80 80 75 62 62 62 62 62 58 58 58 58 58 58 50 50 50 50 50 56 70))) 3 | (DEF TEMP (QUOTE (27 27 25 24 22 23 24 24 23 18 18 17 18 19 18 18 19 19 20 20 20))) 4 | (DEF CONC (QUOTE (89 88 90 87 87 87 93 93 87 80 89 88 82 93 89 86 72 79 80 82 91))) 5 | -------------------------------------------------------------------------------- /Data/tutorial.lsp: -------------------------------------------------------------------------------- 1 | ; Section 3.1 2 | (def purchases (list 0 2 5 0 3 1 8 0 3 1 1 9 2 4 0 2 9 3 0 1 9 8)) 3 | 4 | ; Section 3.2 5 | (def precipitation (list .77 1.74 .81 1.20 1.95 1.20 .47 1.43 3.37 2.20 3.30 3.09 1.51 2.10 .52 1.62 1.31 .32 .59 .81 2.81 1.87 1.18 1.35 4.75 2.48 .96 1.89 .90 2.05)) 6 | 7 | (def urban (list 184 196 217 284 184 236 189 206 179 170 205 190 204 330 217 242 222 242 249 241)) 8 | (def rural (list 166 146 144 204 158 143 158 180 223 194 194 175 171 155 143 145 131 181 148 144 220 129)) 9 | 10 | ; Section 3.3 11 | (def hc '(.5 .46 .41 .44 .72 .83 .38 .60 .83 .34 .37 .87 .65 .48 .51 .47 .56 .51 .57 .36 .52 .58 .47 .65 .41 .39 .55 .64 .38 .50 .73 .57 .41 1.02 1.10 .43 .41 .41 .52 .70 .52 .51 .49 .61 .46 .55)) 12 | (def co '(5.01 8.60 4.95 7.51 14.59 11.53 5.21 9.62 15.13 3.95 4.12 19.00 11.20 3.45 4.10 4.74 5.36 5.69 6.02 2.03 6.78 6.02 5.22 14.67 4.42 7.24 12.30 7.98 4.10 12.10 14.97 5.04 3.38 23.53 22.92 3.81 1.85 2.26 4.29 14.93 6.35 5.79 4.62 8.43 3.99 7.47)) 13 | 14 | ; Section 6.1 15 | (def iron (list 61 175 111 124 130 173 169 169 160 224 257 333 199)) 16 | (def aluminum (list 13 21 24 23 64 38 33 61 39 71 112 88 54)) 17 | (def absorption (list 4 18 14 18 26 26 21 30 28 36 65 62 40)) 18 | 19 | (def strength (list 14.7 48.0 25.6 10.0 16.0 16.8 20.7 38.8 16.9 27.0 16.0 24.9 7.3 12.8)) 20 | (def depth (list 8.9 36.6 36.8 6.1 6.9 6.9 7.3 8.4 6.5 8.0 4.5 9.9 2.9 2.0)) 21 | (def water (list 31.5 27.0 25.9 39.1 39.2 38.3 33.9 33.8 27.9 33.1 26.3 37.8 34.6 36.4)) 22 | 23 | ; Section 6.2 24 | (def hardness (list 45 55 61 66 71 71 81 86 53 60 64 68 79 81 56 68 75 83 88 59 71 80 82 89 51 59 65 74 81 86)) 25 | (def tensile-strength (list 162 233 232 231 231 237 224 219 203 189 210 210 196 180 200 173 188 161 119 161 151 165 151 128 161 146 148 144 134 127)) 26 | (def abrasion-loss (list 372 206 175 154 136 112 55 45 221 166 164 113 82 32 228 196 128 97 64 249 219 186 155 114 341 340 284 267 215 148)) 27 | 28 | (def yield (list 7.9 9.2 10.5 11.2 12.8 13.3 12.1 12.6 14.0 9.1 10.8 12.5 8.1 8.6 10.1 11.5 12.7 13.7 13.7 14.4 15.5 11.3 12.5 14.5 15.3 16.1 17.5 16.6 18.5 19.2 18.0 20.8 21 17.2 18.4 18.9 )) 29 | (def density (list 1 1 1 2 2 2 3 3 3 4 4 4 1 1 1 2 2 2 3 3 3 4 4 4 1 1 1 2 2 2 3 3 3 4 4 4)) 30 | (def variety (list 1 1 1 1 1 1 1 1 1 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 3 3 3 3 3 3 3 3 3 3 3 3)) 31 | 32 | ; Section 6.5 33 | (def travel-space (list 12.8 12.9 12.9 13.6 14.5 14.6 15.1 17.5 19.5 20.8)) 34 | (def separation (list 5.5 6.2 6.3 7.0 7.8 8.3 7.1 10.0 10.8 11.0)) 35 | 36 | -------------------------------------------------------------------------------- /Examples/abrasiondemo.lsp: -------------------------------------------------------------------------------- 1 | #+macintosh(require ":data:tutorial") 2 | #-macintosh(load-data "tutorial") 3 | 4 | (scatterplot-matrix 5 | (list hardness tensile-strength abrasion-loss) 6 | :variable-labels '("Hardness" "Tensile Strength" "Abrasion Loss")) 7 | 8 | (spin-plot (list hardness tensile-strength abrasion-loss) 9 | :variable-labels '("H" "T" "A")) 10 | -------------------------------------------------------------------------------- /Examples/addbox.lsp: -------------------------------------------------------------------------------- 1 | (defmeth spin-proto :add-box () 2 | (let ((x (send self :visible-range 0)) 3 | (y (send self :visible-range 1)) 4 | (z (send self :visible-range 2))) 5 | (send self :add-lines (list (select x '(0 1 1 0 0)) 6 | (select y '(0 0 1 1 0)) 7 | (select z '(0 0 0 0 0))) 8 | :draw nil) 9 | (send self :add-lines (list (select x '(0 1 1 0 0)) 10 | (select y '(0 0 1 1 0)) 11 | (select z '(1 1 1 1 1))) 12 | :draw nil) 13 | (send self :add-lines (list (select x '(0 0)) 14 | (select y '(0 0)) 15 | (select z '(0 1))) 16 | :draw nil) 17 | (send self :add-lines (list (select x '(0 0)) 18 | (select y '(1 1)) 19 | (select z '(0 1))) 20 | :draw nil) 21 | (send self :add-lines (list (select x '(1 1)) 22 | (select y '(1 1)) 23 | (select z '(0 1))) 24 | :draw nil) 25 | (send self :add-lines (list (select x '(1 1)) 26 | (select y '(0 0)) 27 | (select z '(0 1)))))) 28 | -------------------------------------------------------------------------------- /Examples/addhandrotate.lsp: -------------------------------------------------------------------------------- 1 | ;; add a new "mouse mode", with menu title, cusror and mouse method name 2 | (send spin-proto :add-mouse-mode 'hand-rotate 3 | :title "Hand Rotate" :cursor 'hand :click :do-hand-rotate) 4 | 5 | ;; set up local environment with function to project (x, y) point onto 6 | ;; "globe" overthe plot 7 | (flet ((calcsphere (x y) 8 | (let* ((norm-2 (+ (* x x) (* y y))) 9 | (rad-2 (^ 1.7 2)) 10 | (z (if (< norm-2 rad-2) (sqrt (- rad-2 norm-2)) 0))) 11 | (if (< norm-2 rad-2) 12 | (list x y z) 13 | (let ((r (sqrt (max norm-2 rad-2)))) 14 | (list (/ x r) (/ y r) (/ z r))))))) 15 | 16 | ;; define the :DO-HAND-ROTATE method in the local environment 17 | (defmeth spin-proto :do-hand-rotate (x y m1 m2) 18 | (let* ((oldp (apply #'calcsphere 19 | (send self :canvas-to-scaled x y))) 20 | (p oldp) 21 | (vars (send self :content-variables)) 22 | (trans (identity-matrix (send self :num-variables)))) 23 | (send self :idle-on nil) 24 | (send self :while-button-down 25 | #'(lambda (x y) 26 | (setf oldp p) 27 | (setf p (apply #'calcsphere 28 | (send self :canvas-to-scaled x y))) 29 | (setf (select trans vars vars) (make-rotation oldp p)) 30 | (when m1 31 | (send self :slot-value 'rotation-type trans) 32 | (send self :idle-on t)) 33 | (send self 34 | :apply-transformation 35 | trans)))))) 36 | 37 | 38 | 39 | 40 | -------------------------------------------------------------------------------- /Examples/bcdemo.lsp: -------------------------------------------------------------------------------- 1 | ;; define a function to compute the Box-Cox transformation 2 | (defun bc (x c p) 3 | (let* ((x (- x c)) 4 | (bcx (if (< (abs p) .0001) 5 | (log x) 6 | (/ (^ x p) p))) 7 | (min (min bcx)) 8 | (max (max bcx))) 9 | (/ (- bcx min) (- max min)))) 10 | 11 | 12 | ;; get a sorted sample from a shi-squared distribution 13 | (def x (sort-data (chisq-rand 30 4))) 14 | 15 | ;; compute the normal quantiles of the expected uniform order statistics 16 | (def r (normal-quant (/ (iseq 1 30) 31))) 17 | 18 | ;; construct an initial plot without transformation 19 | (def myplot (plot-points r (bc x 0 1))) 20 | 21 | ;;; 22 | ;;; First approach: compute as needed 23 | ;;; 24 | ;; construct a dialog for scrolling through powers and recomputing the 25 | ;; plot 26 | #| 27 | (interval-slider-dialog (list -1 2) 28 | :points 20 29 | :action #'(lambda (p) 30 | (send myplot :clear nil) 31 | (send myplot 32 | :add-points r (bc x 0 p)))) 33 | |# 34 | ;;; 35 | ;;; Second aproach: precompute 36 | ;;; 37 | ;; construct a list of powers 38 | (def powers (rseq -1 2 16)) 39 | 40 | ;; compute transformed data for each power 41 | (def xlist (mapcar #'(lambda (p) (bc x 0 p)) powers)) 42 | 43 | ;; construct a dialog for scrolling through the list of data sets 44 | ;; and redrawing the plot 45 | (sequence-slider-dialog xlist 46 | :display powers 47 | :action #'(lambda (x) 48 | (send myplot :clear nil) 49 | (send myplot :add-points r x))) 50 | 51 | -------------------------------------------------------------------------------- /Examples/fstat.lsp: -------------------------------------------------------------------------------- 1 | (defun f-statistic (m1 m2) 2 | " 3 | Args: (m1 m2) 4 | Computes the F statistic for testing model m1 within model m2." 5 | (let ((ss1 (send m1 :sum-of-squares)) 6 | (df1 (send m1 :df)) 7 | (ss2 (send m2 :sum-of-squares)) 8 | (df2 (send m2 :df))) 9 | (/ (/ (- ss1 ss2) (- df1 df2)) (/ ss2 df2)))) 10 | 11 | -------------------------------------------------------------------------------- /Examples/regdemo.lsp: -------------------------------------------------------------------------------- 1 | 2 | ;; set up some simulated data 3 | (def x (append (iseq 1 18) (list 30 40))) 4 | (def y (+ x (* 2 (normal-rand 20)))) 5 | 6 | ;; construct the plot 7 | (def myplot (plot-points x y)) 8 | 9 | ;; add a new "mouse mode", with menu title, cusror and mouse method name 10 | (send myplot :add-mouse-mode 'point-moving 11 | :title "Point Moving" 12 | :cursor 'finger 13 | :click :do-point-moving) 14 | 15 | ;; add the new mouse method 16 | (defmeth myplot :do-point-moving (x y a b) 17 | (let ((p (send self :drag-point x y :draw nil))) 18 | (if p (send self :set-regression-line)))) 19 | 20 | ;; add method for drawing the regression line for the current data 21 | (defmeth myplot :set-regression-line () 22 | (let ((coefs (send self :calculate-coefficients))) 23 | (send self :clear-lines :draw nil) 24 | (send self :abline (select coefs 0) (select coefs 1)))) 25 | 26 | ;; add method for calculating regression coefficients for current data 27 | (defmeth myplot :calculate-coefficients () 28 | (let* ((i (iseq 0 (- (send self :num-points) 1))) 29 | (x (send self :point-coordinate 0 i)) 30 | (y (send self :point-coordinate 1 i)) 31 | (m (regression-model x y :print nil))) 32 | (send m :coef-estimates))) 33 | 34 | ;; add the regression line 35 | (send myplot :set-regression-line) 36 | 37 | ;; put the plot in "point moving" mode 38 | (send myplot :mouse-mode 'point-moving) 39 | -------------------------------------------------------------------------------- /Examples/tour.lsp: -------------------------------------------------------------------------------- 1 | (provide "tour") 2 | 3 | (defun sphere-rand (n) 4 | (loop (let* ((x (- (* 2 (uniform-rand n)) 1)) 5 | (nx2 (sum (^ x 2)))) 6 | (if (< nx2 1) (return (/ x (sqrt nx2))))))) 7 | 8 | 9 | (defun tour-plot (&rest args) 10 | (let ((p (apply #'spin-plot args))) 11 | (send p :add-slot 'tour-count -1) 12 | (send p :add-slot 'tour-trans nil) 13 | (defmeth p :do-idle () (send self :tour-step) (pause 2)) 14 | (defmeth p :tour-step () 15 | (when (< (slot-value 'tour-count) 0) 16 | (let ((vars (send self :num-variables)) 17 | (angle (abs (send self :angle)))) 18 | (setf (slot-value 'tour-count) 19 | (random (floor (/ pi (* 2 angle))))) 20 | (setf (slot-value 'tour-trans) 21 | (make-rotation (sphere-rand vars) 22 | (sphere-rand vars) 23 | angle)))) 24 | (send self :apply-transformation (slot-value 'tour-trans)) 25 | (setf (slot-value 'tour-count) (- (slot-value 'tour-count) 1))) 26 | (defmeth p :tour-on (&rest args) (apply #'send self :idle-on args)) 27 | (let ((item (send graph-item-proto :new "Touring" p 28 | :tour-on :tour-on :toggle t))) 29 | (send item :key #\T) 30 | (send (send p :menu) :append-items item)) 31 | p)) 32 | 33 | -------------------------------------------------------------------------------- /Examples/tourdemo.lsp: -------------------------------------------------------------------------------- 1 | #+macintosh(require "tour" ":Examples:tour") 2 | #+macintosh(require ":Data:iris") 3 | #+unix(require "tour" "Examples/tour") 4 | #+unix(load-data "iris") 5 | #+msdos(require "tour" "Examples\\tour") 6 | #+msdos(load-data "iris") 7 | 8 | (tour-plot 9 | (mapcar #'(lambda (x) (select x (* 2 (iseq 0 74)))) iris) 10 | :variable-labels '("X" "Y" "Z" "W")) 11 | -------------------------------------------------------------------------------- /Extras/regexp/Makefile.in: -------------------------------------------------------------------------------- 1 | SHELL = /bin/sh 2 | CC = @CC@ 3 | SHLIB_CFLAGS = @SHLIB_CFLAGS@ 4 | SHLIB_LD = @SHLIB_LD@ 5 | SHLIB_LD_LIBS = @SHLIB_LD_LIBS@ 6 | LIBDIR = @LIBDIR@ 7 | INCDIR = @INCDIR@ 8 | 9 | CMPCMD = ${LIBDIR}/xlisp -w${LIBDIR}/xlisp.wks 10 | WRPCMD = ${CMPCMD} ../wrappers/wrap 11 | INSTDIR = ${LIBDIR}/Autoload/Extras/regexp 12 | 13 | COPTFLAGS = -g 14 | CFLAGS = $(COPTFLAGS) -I${INCDIR} ${SHLIB_CFLAGS} 15 | 16 | REOBJS = @REOBJS@ 17 | 18 | all: regexp.dll regexp.fsl 19 | 20 | install: all 21 | -mkdir -p ${INSTDIR} 22 | cp regexp.dll regexp.fsl _autoidx.lsp ${INSTDIR} 23 | 24 | regexp.dll: regexp.o ${REOBJS} 25 | ${SHLIB_LD} -o regexp.dll regexp.o ${REOBJS} ${SHLIB_LD_LIBS} 26 | 27 | regexp.fsl: regexp.lsp 28 | echo "(compile-file \"regexp.lsp\") (exit)" | ${CMPCMD} 29 | 30 | regexp.c regexp.lsp: regexp.wrp 31 | echo "(wrap:make-wrappers \"regexp.wrp\")" | ${WRPCMD} 32 | 33 | rtest: rtest.o ${REOBJS} 34 | $(CC) -o rtest rtest.o ${REOBJS} 35 | 36 | regcomp.o: regex/regcomp.c 37 | $(CC) -Iregex $(CFLAGS) -c regex/regcomp.c 38 | regerror.o: regex/regerror.c 39 | $(CC) -Iregex $(CFLAGS) -c regex/regerror.c 40 | regexec.o: regex/regexec.c 41 | $(CC) -Iregex $(CFLAGS) -c regex/regexec.c 42 | regfree.o: regex/regfree.c 43 | $(CC) -Iregex $(CFLAGS) -c regex/regfree.c 44 | 45 | clean: 46 | rm -f *.o lib.exp rtest 47 | 48 | veryclean: clean 49 | rm -f Makefile regexp.c regexp.lsp regexp.fsl regexp.dll config.* 50 | -------------------------------------------------------------------------------- /Extras/regexp/README: -------------------------------------------------------------------------------- 1 | This is a simple regular expression library for xlispstat. For more 2 | information see 3 | 4 | http://stat.umn.edu/~luke/xls/projects/regexp/regexp.html 5 | 6 | Files: 7 | 8 | Makefile.in Makefile configure template 9 | README this file 10 | _autoidx.lsp autoload index 11 | configure configuration script 12 | configure.in autoconf input for making configure 13 | makefile.bc makefile for Win32, Borland C++ 5.0 14 | makefile.vc makefile for Win32, Microsoft VC++ 5.0 15 | regex Spencer library for systems w/o their own 16 | regexp.wrp lisp and wrapper code for the library 17 | rtest.c simple stand-alone test for system regular expressions 18 | sys%2ftypes.h fake sys/types.h for MacPPC, CW Pro 2 19 | vcregexp.def export definition for Win32, Microsoft VC++ 5.0 20 | regexp.def export definition for Win32, Borland C++ 5.0 21 | regexp.exp export definition for MacPPC, CW Pro 2 22 | 23 | UNIX: 24 | 25 | Executing 26 | 27 | configure 28 | make install 29 | 30 | should make the library and install it in the Autoload 31 | directory of the source tree. After configure, make rtest will 32 | make the little stand-alone test. 33 | 34 | Macintosh, CW Pro 2: 35 | 36 | Make the wrappers with (wrap:make-wrappers "regexp.wrp"). 37 | Get the project file from 38 | 39 | http://stat.umn.edu/~luke/xls/projects/regexp/MacPPC 40 | 41 | Rename sys%2ftypes.h to sys/types.h and build. Manually 42 | install in the Autoload folder 43 | 44 | Windows, Borland C++: 45 | 46 | Make the wrappers with (wrap:make-wrappers "regexp.wrp"). 47 | Adjust the defines at the top of makefile.bc and 48 | 49 | make -f makefile.bc 50 | 51 | Then manually install in Autoload directory. 52 | -------------------------------------------------------------------------------- /Extras/regexp/_autoidx.lsp: -------------------------------------------------------------------------------- 1 | (provide "regexp") 2 | 3 | (defpackage "REGULAR-EXPRESSIONS" 4 | (:use "COMMON-LISP") 5 | (:nicknames "REGEXP")) 6 | 7 | (in-package "REGEXP") 8 | 9 | (export '(REG_EXTENDED REG_NEWLINE REG_NOSUB REG_ICASE REG_NOTBOL REG_NOTEOL 10 | regcomp regexec 11 | regexp regsub url-decode)) 12 | 13 | (system:define-autoload-module "regexp" 14 | (variable REG_EXTENDED REG_NEWLINE REG_NOSUB REG_ICASE REG_NOTBOL REG_NOTEOL) 15 | (function regcomp regexec 16 | regexp regsub url-decode)) 17 | -------------------------------------------------------------------------------- /Extras/regexp/configure.in: -------------------------------------------------------------------------------- 1 | # Adapted from Tcl and Welch p. 545 2 | 3 | AC_INIT(Makefile.in) 4 | 5 | # Get the application library directory. 6 | AC_ARG_WITH(libdir, 7 | [ --with-libdir=DIR library directory for application], 8 | [LIBDIR=$withval;INCDIR="$LIBDIR/include"], 9 | [LIBDIR=`cd ../..; pwd`;INCDIR=$LIBDIR]) 10 | if test ! -d $LIBDIR; then 11 | AC_MSG_ERROR(library directory $LIBDIR does not exist) 12 | fi 13 | 14 | # Recover system configuration information. 15 | . $LIBDIR/shlibconfig.sh 16 | 17 | AC_CHECK_FUNC(regcomp, 18 | REOBJS="", 19 | REOBJS="regcomp.o regerror.o regexec.o regfree.o") 20 | 21 | # Register configuration variables for substitution. 22 | AC_SUBST(CC) 23 | AC_SUBST(SHLIB_CFLAGS) 24 | AC_SUBST(SHLIB_LD) 25 | AC_SUBST(SHLIB_SUFFIX) 26 | AC_SUBST(SHLIB_LD_LIBS) 27 | AC_SUBST(LIBDIR) 28 | AC_SUBST(INCDIR) 29 | AC_SUBST(REOBJS) 30 | 31 | # Output the Makefile 32 | AC_OUTPUT(Makefile) 33 | -------------------------------------------------------------------------------- /Extras/regexp/makefile.bc: -------------------------------------------------------------------------------- 1 | XLSDIR = ..\.. 2 | WXLSDIR = $(XLSDIR)\msdos 3 | XLSLIB = $(WXLSDIR)\wxls32.lib 4 | 5 | BCC32 = $(TOOLBIN)\BCC32 6 | LINK32 = $(TOOLBIN)\ILINK32 7 | 8 | TOOLS = F:\BC5 9 | TOOLBIN = $(TOOLS)\BIN 10 | LIBDIRS = $(TOOLS)\LIB 11 | INCDIRS = $(TOOLS)\INCLUDE;$(WXLSDIR);$(XLSDIR);.\regex 12 | 13 | DEFINES = -DSTRICT -DPOSIX_MISTAKE -DHAVE_MEMMOVE 14 | CFLAGS = -w- -v -H=regexp.csm -WD -I$(INCDIRS) $(DEFINES) 15 | LDOPTS = -L$(LIBDIRS) -Tpd -aa -c $(TOOLS)\LIB\c0d32.obj 16 | 17 | .c.obj: 18 | $(BCC32) +cfgdll.cfg -c $< 19 | {$(WXLSDIR)}.c.obj: 20 | $(BCC32) +cfgdll.cfg -c $< 21 | {regex}.c.obj: 22 | $(BCC32) +cfgdll.cfg -c $< 23 | 24 | OBJECTS = dllstub.obj regexp.obj \ 25 | regcomp.obj regerror.obj regexec.obj regfree.obj 26 | 27 | regexp.dll : $(OBJECTS) $(XLSLIB) regexp.def 28 | $(LINK32) @&&| 29 | /v $(LDOPTS) $(OBJECTS) 30 | $<,$* 31 | $(XLSLIB) import32.lib cw32.lib 32 | regexp.def 33 | | 34 | 35 | $(OBJECTS) : cfgdll.cfg 36 | 37 | # Compiler configuration files 38 | cfgdll.cfg : makefile.bc 39 | Copy &&| 40 | $(CFLAGS) 41 | | $@ 42 | 43 | 44 | # Remove all generated files 45 | clean: 46 | -@erase *.exe 47 | -@erase *.lib 48 | -@erase *.dll 49 | -@erase *.obj 50 | -@erase *.cfg 51 | -@erase *.map 52 | 53 | -------------------------------------------------------------------------------- /Extras/regexp/makefile.vc: -------------------------------------------------------------------------------- 1 | XLSDIR = ..\.. 2 | WXLSDIR = $(XLSDIR)\msdos 3 | XLSLIB = vcwxls32.lib 4 | 5 | TOOLS = f:\devstudio\vc 6 | CC=$(TOOLS)\bin\cl.exe 7 | LINK32=link.exe 8 | LIB32=lib.exe 9 | 10 | DLL_CFLAGS=/nologo /MT /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_Windows" /FD \ 11 | /D POSIX_MISTAKE /D HAVE_MEMMOVE /I $(WXLSDIR) /I $(XLSDIR) /I regex \ 12 | /D far= 13 | DLL_LDFLAGS=$(STDLIBS) /nologo /subsystem:windows /dll /incremental:no\ 14 | /machine:I386 15 | 16 | STDLIBS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\ 17 | advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib\ 18 | odbccp32.lib 19 | 20 | .c.obj: 21 | $(CC) $(DLL_CFLAGS) -c $< 22 | {$(WXLSDIR)}.c.obj: 23 | $(CC) $(DLL_CFLAGS) -c $< 24 | {regex}.c.obj: 25 | $(CC) $(DLL_CFLAGS) -c $< 26 | 27 | OBJECTS = dllstub.obj regexp.obj \ 28 | regcomp.obj regerror.obj regexec.obj regfree.obj 29 | 30 | regexp.dll : $(OBJECTS) $(XLSLIB) vcregexp.def 31 | $(LINK32) @<< 32 | $(DLL_LDFLAGS) /out:regexp.dll /def:vcregexp.def $(OBJECTS) $(XLSLIB) 33 | << 34 | 35 | vcwxls32.lib: $(WXLSDIR)/wxls32.def 36 | $(LIB32) /def:$(WXLSDIR)/wxls32.def /out:vcwxls32.lib 37 | 38 | clean : 39 | -@erase *.obj 40 | -@erase *.dll 41 | -@erase *.exp 42 | -@erase *.lib 43 | -@erase *.exe 44 | -@erase *.idb 45 | -------------------------------------------------------------------------------- /Extras/regexp/regex/Makefile: -------------------------------------------------------------------------------- 1 | CC=gcc 2 | CFLAGS=-g -I. -DPOSIX_MISTAKE 3 | AR=ar 4 | RANLIB=ranlib 5 | 6 | SRCS= regcomp.c regerror.c regexec.c regfree.c 7 | 8 | OBJ= regcomp.o regerror.o regexec.o regfree.o 9 | 10 | LIB= libregex.a 11 | 12 | $(LIB): $(OBJ) 13 | $(AR) cr $(LIB) $(OBJ) 14 | $(RANLIB) $(LIB) 15 | 16 | clean: 17 | rm -f *.o *.a 18 | -------------------------------------------------------------------------------- /Extras/regexp/regex/utils.h: -------------------------------------------------------------------------------- 1 | /*- 2 | * Copyright (c) 1992, 1993, 1994 Henry Spencer. 3 | * Copyright (c) 1992, 1993, 1994 4 | * The Regents of the University of California. All rights reserved. 5 | * 6 | * This code is derived from software contributed to Berkeley by 7 | * Henry Spencer. 8 | * 9 | * Redistribution and use in source and binary forms, with or without 10 | * modification, are permitted provided that the following conditions 11 | * are met: 12 | * 1. Redistributions of source code must retain the above copyright 13 | * notice, this list of conditions and the following disclaimer. 14 | * 2. Redistributions in binary form must reproduce the above copyright 15 | * notice, this list of conditions and the following disclaimer in the 16 | * documentation and/or other materials provided with the distribution. 17 | * 3. All advertising materials mentioning features or use of this software 18 | * must display the following acknowledgement: 19 | * This product includes software developed by the University of 20 | * California, Berkeley and its contributors. 21 | * 4. Neither the name of the University nor the names of its contributors 22 | * may be used to endorse or promote products derived from this software 23 | * without specific prior written permission. 24 | * 25 | * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND 26 | * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 27 | * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 28 | * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE 29 | * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 30 | * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 31 | * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 32 | * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 33 | * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 34 | * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 35 | * SUCH DAMAGE. 36 | * 37 | * @(#)utils.h 8.3 (Berkeley) 3/20/94 38 | */ 39 | 40 | /* utility definitions */ 41 | #define DUPMAX _POSIX2_RE_DUP_MAX /* xxx is this right? */ 42 | #define INFINITY (DUPMAX + 1) 43 | #define NC (CHAR_MAX - CHAR_MIN + 1) 44 | typedef unsigned char uch; 45 | 46 | /* switch off assertions (if not already off) if no REDEBUG */ 47 | #ifndef REDEBUG 48 | #ifndef NDEBUG 49 | #define NDEBUG /* no assertions please */ 50 | #endif 51 | #endif 52 | #include 53 | 54 | /* for old systems with bcopy() but no memmove() */ 55 | #ifndef HAVE_MEMMOVE 56 | #define memmove(d, s, c) bcopy(s, d, c) 57 | #endif 58 | -------------------------------------------------------------------------------- /Extras/regexp/regexp.def: -------------------------------------------------------------------------------- 1 | EXPORTS 2 | regexp__init=_regexp__init 3 | -------------------------------------------------------------------------------- /Extras/regexp/regexp.exp: -------------------------------------------------------------------------------- 1 | regexp__init 2 | -------------------------------------------------------------------------------- /Extras/regexp/rtest.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | 5 | int match(char *string, char *pattern) 6 | { 7 | int i; 8 | regex_t re; 9 | char buf[256]; 10 | 11 | i=regcomp(&re, pattern, REG_EXTENDED|REG_NOSUB); 12 | if (i != 0) { 13 | (void)regerror(i,&re,buf,sizeof buf); 14 | printf("%s\n",buf); 15 | return(0); /* report error */ 16 | } 17 | i = regexec(&re, string, (size_t) 0, NULL, 0); 18 | regfree(&re); 19 | if (i != 0) { 20 | (void)regerror(i,&re,buf,sizeof buf); 21 | printf("%s\n",buf); 22 | return(0); /* report error */ 23 | } 24 | return(1); 25 | } 26 | 27 | void main() 28 | { 29 | printf("%s\n", match("ABCDE", "[A-Z]*") ? "success" : "failure"); 30 | } 31 | -------------------------------------------------------------------------------- /Extras/regexp/sys%2ftypes.h: -------------------------------------------------------------------------------- 1 | /* fake sys/types.h file for Macintosh CW Pro 2 */ 2 | typedef long off_t; 3 | #define bcopy(from,to,n) memcpy(to,from,n) 4 | -------------------------------------------------------------------------------- /Extras/regexp/vcregexp.def: -------------------------------------------------------------------------------- 1 | EXPORTS 2 | regexp__init 3 | -------------------------------------------------------------------------------- /Extras/sockets/Makefile.in: -------------------------------------------------------------------------------- 1 | SHELL = /bin/sh 2 | CC = @CC@ 3 | SHLIB_CFLAGS = @SHLIB_CFLAGS@ 4 | SHLIB_LD = @SHLIB_LD@ 5 | SHLIB_LD_LIBS = @SHLIB_LD_LIBS@ 6 | LIBDIR = @LIBDIR@ 7 | INCDIR = @INCDIR@ 8 | 9 | CMPCMD = ${LIBDIR}/xlisp -w${LIBDIR}/xlisp.wks 10 | INSTDIR = ${LIBDIR}/Autoload/Extras/sockets 11 | 12 | COPTFLAGS = -g 13 | CFLAGS = $(COPTFLAGS) -I${INCDIR} ${SHLIB_CFLAGS} 14 | 15 | all: xlsock.dll sock.fsl 16 | 17 | install: all 18 | -mkdir -p ${INSTDIR} 19 | cp xlsock.dll sock.fsl _autoidx.lsp ${INSTDIR} 20 | 21 | xlsock.dll: xlsock.o sock.o 22 | ${SHLIB_LD} -o xlsock.dll xlsock.o sock.o ${SHLIB_LD_LIBS} 23 | 24 | sock.fsl: sock.lsp 25 | echo "(compile-file \"sock.lsp\") (exit)" | ${CMPCMD} 26 | 27 | echotest: echotest.o sock.o 28 | $(CC) -o echotest echotest.o sock.o 29 | 30 | echoserv: echoserv.o sock.o 31 | $(CC) -o echoserv echoserv.o sock.o 32 | 33 | clean: 34 | rm -f *.o echotest echoserv lib.exp 35 | 36 | veryclean: clean 37 | rm -f Makefile sock.fsl xlsock.dll config.* 38 | 39 | -------------------------------------------------------------------------------- /Extras/sockets/README: -------------------------------------------------------------------------------- 1 | This is a simple socket library for xlispstat. For more information 2 | see 3 | 4 | http://stat.umn.edu/~luke/xls/projects/sock/sock.html 5 | 6 | Files: 7 | 8 | Makefile.in Makefile configure template 9 | README this file 10 | _autoidx.lsp Autoload index 11 | configure configuration script 12 | configure.in autoconf input for making configure 13 | echoserv.c simple echo server test 14 | echotest.c simple echo client test 15 | makefile.bc makefile for Win32, Borland C++ 5.0 16 | makefile.vc makefile for Win32, Microsoft VC++ 5.0 17 | sock.c C socket interface 18 | sock.h include file for sock.c's interface 19 | sock.lsp lisp code for the library 20 | socktest.lsp some test examles 21 | vcxlsock.def export definition for Win32, Microsoft VC++ 5.0 22 | xlsock.c C code for the library 23 | xlsock.def export definition for Win32, Borland C++ 5.0 24 | xlsock.exp export definition for MacPPC, CW Pro 2 25 | 26 | UNIX: 27 | 28 | Executing 29 | 30 | configure 31 | make install 32 | 33 | should make the library and install it in the Autoload 34 | directory of the source tree. 35 | 36 | After configure, make echoserv echotest will make the little 37 | stand-alone tests. 38 | 39 | Macintosh, CW Pro 2: 40 | 41 | Get the project file from 42 | 43 | http://stat.umn.edu/~luke/xls/projects/sock/MacPPC 44 | 45 | and get CWGUSI from 46 | 47 | ftp://sunsite.cnlab-switch.ch/software/platform/macos/src/mw_c/ 48 | 49 | I used version 1.8.1 but had to make two small changes for CW 50 | Pro 2 _ I think they were fairly obvious. Build, and manually 51 | install in the Autoload folder 52 | 53 | Windows, Borland C++: 54 | 55 | Adjust the defines at the top of makefile.bc and 56 | 57 | make -f makefile.bc 58 | 59 | Then manually install in Autoload directory. 60 | -------------------------------------------------------------------------------- /Extras/sockets/_autoidx.lsp: -------------------------------------------------------------------------------- 1 | (defpackage "SOCKETS" (:use "COMMON-LISP")) 2 | (in-package "SOCKETS") 3 | 4 | (export '(with-client-socket socket-read-line socket-write-line 5 | socket-force-output socket-write-string 6 | with-server-socket-loop)) 7 | 8 | (system:define-autoload-module "sock" 9 | (function with-client-socket socket-read-line socket-write-line 10 | socket-force-output socket-write-string 11 | socket-read-byte 12 | with-server-socket-loop)) 13 | -------------------------------------------------------------------------------- /Extras/sockets/configure.in: -------------------------------------------------------------------------------- 1 | # Adapted from Tcl and Welch p. 545 2 | 3 | AC_INIT(Makefile.in) 4 | 5 | # Get the application library directory. 6 | AC_ARG_WITH(libdir, 7 | [ --with-libdir=DIR library directory for application], 8 | [LIBDIR=$withval;INCDIR="$LIBDIR/include"], 9 | [LIBDIR=`cd ../..; pwd`;INCDIR=$LIBDIR]) 10 | if test ! -d $LIBDIR; then 11 | AC_MSG_ERROR(library directory $LIBDIR does not exist) 12 | fi 13 | 14 | # Recover system configuration information. 15 | . $LIBDIR/shlibconfig.sh 16 | 17 | # Register configuration variables for substitution. 18 | AC_SUBST(CC) 19 | AC_SUBST(SHLIB_CFLAGS) 20 | AC_SUBST(SHLIB_LD) 21 | AC_SUBST(SHLIB_SUFFIX) 22 | AC_SUBST(SHLIB_LD_LIBS) 23 | AC_SUBST(LIBDIR) 24 | AC_SUBST(INCDIR) 25 | 26 | # Output the Makefile 27 | AC_OUTPUT(Makefile) 28 | -------------------------------------------------------------------------------- /Extras/sockets/echoserv.c: -------------------------------------------------------------------------------- 1 | #if defined(__MWERKS__) && defined(macintosh) 2 | # define MACINTOSH 3 | #elif defined(_Windows) 4 | typedef long ssize_t 5 | #endif 6 | 7 | #include 8 | #include 9 | #include 10 | #ifndef MACINTOSH 11 | # include 12 | #endif 13 | #include 14 | #include 15 | #include "sock.h" 16 | 17 | #define BLKSIZE 1024 18 | #ifndef MAX_CANON 19 | # define MAX_CANON 128 20 | #endif 21 | 22 | static void serverr(char *fmt, ...) 23 | { 24 | va_list ap; 25 | va_start(ap, fmt); 26 | vfprintf(stderr, fmt, ap); 27 | va_end(ap); 28 | exit(1); 29 | } 30 | 31 | static void message(char *fmt, ...) 32 | { 33 | va_list ap; 34 | va_start(ap, fmt); 35 | vfprintf(stderr, fmt, ap); 36 | va_end(ap); 37 | fflush(stderr); 38 | } 39 | 40 | #ifdef __MWERKS__ 41 | #include 42 | void main(void) 43 | { 44 | char **argv; 45 | int argc = ccommand(&argv); 46 | #else 47 | void main(int argc, char *argv[]) 48 | { 49 | #endif 50 | Sock_port_t portnumber; 51 | int listenfd, communfd; 52 | char remote[MAX_CANON]; 53 | char buf[BLKSIZE]; 54 | ssize_t bytesread, byteswritten; 55 | int i; 56 | 57 | if (argc != 2) 58 | serverr("Usage: %s port\n", argv[0]); 59 | portnumber = (Sock_port_t) atoi(argv[1]); 60 | 61 | if (Sock_init() != 0) 62 | serverr("Sock initialization failed"); 63 | 64 | if ((listenfd = Sock_open(portnumber, NULL)) < 0) 65 | serverr("Unable to establish a port connection"); 66 | 67 | if ((communfd = Sock_listen(listenfd, remote, MAX_CANON, NULL)) < 0) 68 | serverr("Failure to listen on server"); 69 | message("Connection has been made to %s\n", remote); 70 | 71 | while((bytesread = Sock_read(communfd, buf, BLKSIZE, NULL)) > 0) { 72 | byteswritten = Sock_write(communfd, buf, bytesread, NULL); 73 | if (byteswritten != bytesread) { 74 | Sock_close(communfd, NULL); 75 | Sock_close(listenfd, NULL); 76 | serverr("Error writing %ld bytes, %ld bytes written\n", 77 | (long) bytesread, (long) byteswritten); 78 | } 79 | } 80 | message("Connection closed by client\n"); 81 | 82 | Sock_close(communfd, NULL); 83 | Sock_close(listenfd, NULL); 84 | } 85 | -------------------------------------------------------------------------------- /Extras/sockets/echotest.c: -------------------------------------------------------------------------------- 1 | #if defined(__MWERKS__) && defined(macintosh) 2 | # define MACINTOSH 3 | #elif defined(_Windows) 4 | typedef long ssize_t 5 | #endif 6 | 7 | #include 8 | #include 9 | #include 10 | #include 11 | #ifndef MACINTOSH 12 | # include 13 | #endif 14 | #include "sock.h" 15 | 16 | #define BLKSIZE 1024 17 | 18 | #ifdef __MWERKS__ 19 | #include 20 | void main(void) 21 | { 22 | char **argv; 23 | int argc = ccommand(&argv); 24 | #else 25 | void main(int argc, char *argv[]) 26 | { 27 | #endif 28 | Sock_port_t portnumber = 7; 29 | int sockfd; 30 | ssize_t bytesread, i; 31 | ssize_t byteswritten; 32 | char buf[BLKSIZE]; 33 | char *hostname = "localhost"; 34 | 35 | switch (argc) { 36 | case 3: portnumber = atoi(argv[2]); 37 | case 2: hostname = argv[1]; 38 | case 1: break; 39 | default: 40 | fprintf(stderr, "Usage: %s host port\n", argv[0]); 41 | exit(1); 42 | } 43 | 44 | if (Sock_init() != 0) { 45 | fprintf(stderr, "Sock initialization failed"); 46 | exit(1); 47 | } 48 | 49 | if ((sockfd = Sock_connect(portnumber, hostname, NULL)) < 0) { 50 | perror("Unable to establish an Internet connection"); 51 | exit(1); 52 | } 53 | fprintf(stderr, "Connection has been made to %s\n", hostname); 54 | 55 | for ( ; ; ) { 56 | for (bytesread = 0; bytesread < BLKSIZE; bytesread++) { 57 | int ch = getc(stdin); 58 | if (ch == EOF) 59 | break; 60 | else if (ch == '\n') { 61 | buf[bytesread++] = ch; 62 | break; 63 | } 64 | else 65 | buf[bytesread] = ch; 66 | } 67 | if (bytesread <= 0) break; 68 | else { 69 | byteswritten = Sock_write(sockfd, buf, bytesread, NULL); 70 | if (byteswritten != bytesread) { 71 | fprintf(stderr, 72 | "Error writing %ld bytes, %ld bytes written\n", 73 | (long)bytesread, (long)byteswritten); 74 | break; 75 | } 76 | } 77 | bytesread = Sock_read(sockfd, buf, BLKSIZE, NULL); 78 | for (i = 0; i < bytesread; i++) 79 | putc(buf[i], stdout); 80 | } 81 | 82 | Sock_close(sockfd, NULL); 83 | exit(0); 84 | } 85 | -------------------------------------------------------------------------------- /Extras/sockets/makefile.bc: -------------------------------------------------------------------------------- 1 | XLSDIR = ..\.. 2 | WXLSDIR = $(XLSDIR)\msdos 3 | XLSLIB = $(WXLSDIR)\wxls32.lib 4 | 5 | BCC32 = $(TOOLBIN)\BCC32 6 | LINK32 = $(TOOLBIN)\ILINK32 7 | 8 | TOOLS = F:\BC5 9 | TOOLBIN = $(TOOLS)\BIN 10 | LIBDIRS = $(TOOLS)\LIB 11 | INCDIRS = $(TOOLS)\INCLUDE;$(WXLSDIR);$(XLSDIR);. 12 | 13 | DEFINES = -DSTRICT 14 | CFLAGS = -w- -v -H=sock.csm -WD -I$(INCDIRS) $(DEFINES) 15 | LDOPTS = -L$(LIBDIRS) -Tpd -aa -c $(TOOLS)\LIB\c0d32.obj 16 | 17 | .c.obj: 18 | $(BCC32) +cfgdll.cfg -c $< 19 | {$(WXLSDIR)}.c.obj: 20 | $(BCC32) +cfgdll.cfg -c $< 21 | 22 | OBJECTS = dllstub.obj xlsock.obj sock.obj 23 | 24 | xlsock.dll : $(OBJECTS) $(XLSLIB) xlsock.def 25 | $(LINK32) @&&| 26 | /v $(LDOPTS) $(OBJECTS) 27 | $<,$* 28 | $(XLSLIB) import32.lib cw32.lib 29 | xlsock.def 30 | | 31 | 32 | $(OBJECTS) : cfgdll.cfg 33 | 34 | # Compiler configuration files 35 | cfgdll.cfg : makefile.bc 36 | Copy &&| 37 | $(CFLAGS) 38 | | $@ 39 | 40 | 41 | # Remove all generated files 42 | clean: 43 | -@erase *.exe 44 | -@erase *.lib 45 | -@erase *.dll 46 | -@erase *.obj 47 | -@erase *.cfg 48 | -@erase *.map 49 | 50 | -------------------------------------------------------------------------------- /Extras/sockets/makefile.vc: -------------------------------------------------------------------------------- 1 | XLSDIR = ..\.. 2 | WXLSDIR = $(XLSDIR)\msdos 3 | XLSLIB = vcwxls32.lib 4 | 5 | TOOLS = f:\devstudio\vc 6 | CC=$(TOOLS)\bin\cl.exe 7 | LINK32=link.exe 8 | LIB32=lib.exe 9 | 10 | DLL_CFLAGS=/nologo /MT /W3 /GX /O2 /D "WIN32" /D "NDEBUG" /D "_Windows" /FD \ 11 | /I $(WXLSDIR) /I $(XLSDIR) /D far= 12 | DLL_LDFLAGS=$(STDLIBS) /nologo /subsystem:windows /dll /incremental:no\ 13 | /machine:I386 14 | 15 | STDLIBS=kernel32.lib user32.lib gdi32.lib winspool.lib comdlg32.lib\ 16 | advapi32.lib shell32.lib ole32.lib oleaut32.lib uuid.lib odbc32.lib\ 17 | odbccp32.lib wsock32.lib 18 | 19 | .c.obj: 20 | $(CC) $(DLL_CFLAGS) -c $< 21 | {$(WXLSDIR)}.c.obj: 22 | $(CC) $(DLL_CFLAGS) -c $< 23 | 24 | OBJECTS = dllstub.obj xlsock.obj sock.obj 25 | 26 | xlregexp.dll : $(OBJECTS) $(XLSLIB) vcxlsock.def 27 | $(LINK32) @<< 28 | $(DLL_LDFLAGS) /out:xlsock.dll /def:vcxlsock.def $(OBJECTS) $(XLSLIB) 29 | << 30 | 31 | vcwxls32.lib: $(WXLSDIR)/wxls32.def 32 | $(LIB32) /def:$(WXLSDIR)/wxls32.def /out:vcwxls32.lib 33 | 34 | clean : 35 | -@erase *.obj 36 | -@erase *.dll 37 | -@erase *.exp 38 | -@erase *.lib 39 | -@erase *.exe 40 | -@erase *.idb 41 | -------------------------------------------------------------------------------- /Extras/sockets/sock.h: -------------------------------------------------------------------------------- 1 | #ifdef MACINTOSH 2 | typedef int ssize_t; 3 | #include 4 | #endif 5 | #ifdef _Windows 6 | typedef long ssize_t; 7 | #endif 8 | 9 | typedef unsigned short Sock_port_t; 10 | 11 | typedef struct Sock_error_t { 12 | int error; 13 | int h_error; 14 | } *Sock_error_t; 15 | 16 | int Sock_init(void); 17 | int Sock_open(Sock_port_t port, Sock_error_t perr); 18 | int Sock_listen(int fd, char *cname, int buflen, Sock_error_t perr); 19 | int Sock_connect(Sock_port_t port, char *sname, Sock_error_t perr); 20 | int Sock_close(int fd, Sock_error_t perr); 21 | ssize_t Sock_read(int fd, void *buf, size_t nbytes, Sock_error_t perr); 22 | ssize_t Sock_write(int fd, void *buf, size_t nbytes, Sock_error_t perr); 23 | -------------------------------------------------------------------------------- /Extras/sockets/socktest.lsp: -------------------------------------------------------------------------------- 1 | (use-package "SOCKETS") 2 | 3 | (defun server (port &key (fork t)) 4 | (with-server-socket-loop (sock port :fork fork) 5 | (format *error-output* "Connection has been made to ~a~%" "????") 6 | (loop 7 | (let ((byte (socket-read-byte sock nil nil))) 8 | (if byte 9 | (write-char (int-char byte)) 10 | (return)))) 11 | (format *error-output* "socket closed by client~%"))) 12 | 13 | (defun client (host port) 14 | (with-client-socket (sock port host) 15 | (format *error-output* "Connection has been made to ~a:~d~%" host port) 16 | (let ((nl (string #\newline))) 17 | (loop 18 | (let ((line (read-line *standard-input* nil nil))) 19 | (unless line (return)) 20 | (socket-write-string line sock) 21 | (socket-write-string nl sock) 22 | (socket-force-output sock)))))) 23 | 24 | (defun finger (user &optional (host "localhost") (port 79)) 25 | (with-client-socket (sock port host) 26 | (socket-write-line user sock) 27 | (socket-force-output sock) 28 | (with-output-to-string (s) 29 | (loop 30 | (multiple-value-bind (line nlmissing) 31 | (socket-read-line sock nil nil) 32 | (unless line (return)) 33 | (write-string line s) 34 | (unless nlmissing (terpri s))))))) 35 | 36 | (defun echo (&optional (host "localhost") (port 7)) 37 | (with-client-socket (sock port host) 38 | (format *error-output* "Connection has been made to ~a:~d~%" host port) 39 | (loop 40 | (let ((line (read-line *standard-input* nil nil))) 41 | (unless line (return)) 42 | (socket-write-line line sock) 43 | (socket-force-output sock) 44 | (write-line (socket-read-line sock)))))) 45 | 46 | (defun daytime (&optional (host "localhost") (port 13)) 47 | (with-client-socket (sock port host) 48 | (socket-read-line sock))) 49 | -------------------------------------------------------------------------------- /Extras/sockets/vcxlsock.def: -------------------------------------------------------------------------------- 1 | EXPORTS 2 | xlsock__init 3 | -------------------------------------------------------------------------------- /Extras/sockets/xlsock.def: -------------------------------------------------------------------------------- 1 | EXPORTS 2 | xlsock__init=_xlsock__init 3 | -------------------------------------------------------------------------------- /Extras/sockets/xlsock.exp: -------------------------------------------------------------------------------- 1 | xlsock__init 2 | -------------------------------------------------------------------------------- /Extras/wrappers/Makefile.in: -------------------------------------------------------------------------------- 1 | SHELL = /bin/sh 2 | CC = @CC@ 3 | SHLIB_CFLAGS = @SHLIB_CFLAGS@ 4 | SHLIB_LD = @SHLIB_LD@ 5 | SHLIB_LD_LIBS = @SHLIB_LD_LIBS@ 6 | LIBDIR = @LIBDIR@ 7 | INCDIR = @INCDIR@ 8 | 9 | CMPCMD = ${LIBDIR}/xlisp -w${LIBDIR}/xlisp.wks 10 | INSTDIR = ${LIBDIR}/Autoload/Extras/wrappers 11 | 12 | COPTFLAGS = -g 13 | CFLAGS = $(COPTFLAGS) -I${INCDIR} ${SHLIB_CFLAGS} 14 | 15 | all: wrap.fsl wrapptrs.dll wrapptrs.fsl 16 | 17 | install: all 18 | -mkdir -p ${INSTDIR} 19 | cp wrapptrs.dll wrapptrs.fsl wrap.fsl _autoidx.lsp ${INSTDIR} 20 | 21 | wrapptrs.dll: wrapptrs.o 22 | ${SHLIB_LD} -o wrapptrs.dll wrapptrs.o ${SHLIB_LD_LIBS} 23 | 24 | wrapptrs.fsl: wrapptrs.lsp 25 | echo "(compile-file \"wrapptrs.lsp\") (exit)" | ${CMPCMD} 26 | 27 | wrap.fsl: wrap.lsp 28 | echo "(compile-file \"wrap.lsp\") (exit)" | ${CMPCMD} 29 | 30 | wrapptrs.c wrapptrs.lsp: wrapptrs.wrp wrap.fsl 31 | echo "(use-package \"C-WRAPPERS\") (make-wrappers \"wrapptrs.wrp\")" | ${CMPCMD} wrap 32 | 33 | #**** tests? 34 | 35 | clean: 36 | rm -f *.o lib.exp 37 | 38 | veryclean: clean 39 | rm -f Makefile *.fsl *.dll config.* wrapptrs.c wrapptrs.lsp 40 | 41 | -------------------------------------------------------------------------------- /Extras/wrappers/README: -------------------------------------------------------------------------------- 1 | This directory includes a mechanism for generating C interfaces and a 2 | simple pointer interface library for xlispstat. For more information 3 | see 4 | 5 | http://stat.umn.edu/~luke/xls/projects/wrappers/wrappers.html 6 | 7 | Files: 8 | 9 | Makefile.in Makefile configure template 10 | README this file 11 | _autoidx.lsp autoload index 12 | configure configuration script 13 | configure.in autoconf input for making configure 14 | makefile.bc makefile for Win32, Borland C++ 5.0 15 | wrap.lsp C wrapper generation code 16 | wrapptr.wrp pointer wrapper library 17 | wrapptr.def export definition for Win32, Borland C++ 5.0 18 | wrapptr.exp export definition for MacPPC, CW Pro 2 19 | wrapptrs.mu.sit.hqx project file for MacPPC, CW Pro 2 20 | 21 | UNIX: 22 | 23 | Executing 24 | 25 | configure 26 | make install 27 | 28 | should make the library and install it in the Autoload 29 | directory of the source tree. 30 | 31 | Macintosh, CW Pro 2: 32 | 33 | Make the wrappers with (wrap:make-wrappers "wrapptrs.wrp"). 34 | Get the project file from 35 | 36 | http://stat.umn.edu/~luke/xls/projects/wrappers/MacPPC 37 | 38 | Build and manually install in the Autoload folder 39 | 40 | Windows, Borland C++: 41 | 42 | Make the wrappers with (wrap:make-wrappers "wrapptrs.wrp"). 43 | Adjust the defines at the top of makefile.bc and 44 | 45 | make -f makefile.bc 46 | 47 | Then manually install in Autoload directory. 48 | -------------------------------------------------------------------------------- /Extras/wrappers/_autoidx.lsp: -------------------------------------------------------------------------------- 1 | (provide "wrappers") 2 | (defpackage "C-WRAPPERS" (:nicknames "WRAP") (:use "XLISP")) 3 | (in-package "C-WRAPPERS") 4 | 5 | (export '(make-wrappers 6 | c-lines c-constant c-variable c-function c-subr c-pointer c-version)) 7 | 8 | (system:define-autoload-module "wrap" 9 | (function make-wrappers 10 | c-lines c-constant c-variable c-function c-subr c-pointer c-version)) 11 | 12 | (provide "wrapptrs") 13 | (defpackage "POINTER-WRAPPERS" (:nicknames "WRAPPTRS") (:use "XLISP")) 14 | (in-package "WRAPPTRS") 15 | 16 | (export '(make-c-void cast-c-void 17 | make-c-void-p cast-c-void-p offset-c-void-p get-c-void-p 18 | make-c-char cast-c-char offset-c-char get-c-char set-c-char 19 | make-c-schar cast-c-schar offset-c-schar get-c-schar set-c-schar 20 | make-c-uchar cast-c-uchar offset-c-uchar get-c-uchar set-c-uchar 21 | make-c-short cast-c-short offset-c-short get-c-short set-c-short 22 | make-c-ushort cast-c-ushort offset-c-ushort get-c-ushort set-c-ushort 23 | make-c-int cast-c-int offset-c-int get-c-int set-c-int 24 | make-c-uint cast-c-uint offset-c-uint get-c-uint set-c-uint 25 | make-c-long cast-c-long offset-c-long get-c-long set-c-long 26 | make-c-ulong cast-c-ulong offset-c-ulong get-c-ulong set-c-ulong 27 | make-c-float cast-c-float offset-c-float get-c-float set-c-float 28 | make-c-double cast-c-double offset-c-double get-c-double set-c-double 29 | make-c-string cast-c-string offset-c-string get-c-string set-c-string)) 30 | 31 | (system:define-autoload-module "wrapptrs" 32 | (function make-c-void cast-c-void 33 | make-c-void-p cast-c-void-p offset-c-void-p get-c-void-p 34 | make-c-char cast-c-char offset-c-char get-c-char set-c-char 35 | make-c-schar cast-c-schar offset-c-schar get-c-schar set-c-schar 36 | make-c-uchar cast-c-uchar offset-c-uchar get-c-uchar set-c-uchar 37 | make-c-short cast-c-short offset-c-short get-c-short set-c-short 38 | make-c-ushort cast-c-ushort offset-c-ushort get-c-ushort set-c-ushort 39 | make-c-int cast-c-int offset-c-int get-c-int set-c-int 40 | make-c-uint cast-c-uint offset-c-uint get-c-uint set-c-uint 41 | make-c-long cast-c-long offset-c-long get-c-long set-c-long 42 | make-c-ulong cast-c-ulong offset-c-ulong get-c-ulong set-c-ulong 43 | make-c-float cast-c-float offset-c-float get-c-float set-c-float 44 | make-c-double cast-c-double offset-c-double get-c-double set-c-double 45 | make-c-string cast-c-string offset-c-string get-c-string set-c-string)) 46 | -------------------------------------------------------------------------------- /Extras/wrappers/configure.in: -------------------------------------------------------------------------------- 1 | # Adapted from Tcl and Welch p. 545 2 | 3 | AC_INIT(Makefile.in) 4 | 5 | # Get the application library directory. 6 | AC_ARG_WITH(libdir, 7 | [ --with-libdir=DIR library directory for application], 8 | [LIBDIR=$withval;INCDIR="$LIBDIR/include"], 9 | [LIBDIR=`cd ../..; pwd`;INCDIR=$LIBDIR]) 10 | if test ! -d $LIBDIR; then 11 | AC_MSG_ERROR(library directory $LIBDIR does not exist) 12 | fi 13 | 14 | # Recover system configuration information. 15 | . $LIBDIR/shlibconfig.sh 16 | 17 | # Register configuration variables for substitution. 18 | AC_SUBST(CC) 19 | AC_SUBST(SHLIB_CFLAGS) 20 | AC_SUBST(SHLIB_LD) 21 | AC_SUBST(SHLIB_SUFFIX) 22 | AC_SUBST(SHLIB_LD_LIBS) 23 | AC_SUBST(LIBDIR) 24 | AC_SUBST(INCDIR) 25 | 26 | # Output the Makefile 27 | AC_OUTPUT(Makefile) 28 | -------------------------------------------------------------------------------- /Extras/wrappers/makefile.bc: -------------------------------------------------------------------------------- 1 | XLSDIR = ..\.. 2 | WXLSDIR = $(XLSDIR)\msdos 3 | XLSLIB = $(WXLSDIR)\wxls32.lib 4 | 5 | BCC32 = $(TOOLBIN)\BCC32 6 | LINK32 = $(TOOLBIN)\ILINK32 7 | 8 | TOOLS = F:\BC5 9 | TOOLBIN = $(TOOLS)\BIN 10 | LIBDIRS = $(TOOLS)\LIB 11 | INCDIRS = $(TOOLS)\INCLUDE;$(WXLSDIR);$(XLSDIR);. 12 | 13 | DEFINES = -DSTRICT 14 | CFLAGS = -w- -v -H=wrapptrs.csm -WD -I$(INCDIRS) $(DEFINES) 15 | LDOPTS = -L$(LIBDIRS) -Tpd -aa -c $(TOOLS)\LIB\c0d32.obj 16 | 17 | .c.obj: 18 | $(BCC32) +cfgdll.cfg -c $< 19 | {$(WXLSDIR)}.c.obj: 20 | $(BCC32) +cfgdll.cfg -c $< 21 | 22 | OBJECTS = dllstub.obj wrapptrs.obj 23 | 24 | wrapptrs.dll : $(OBJECTS) $(XLSLIB) wrapptrs.def 25 | $(LINK32) @&&| 26 | /v $(LDOPTS) $(OBJECTS) 27 | $<,$* 28 | $(XLSLIB) import32.lib cw32.lib 29 | wrapptrs.def 30 | | 31 | 32 | $(OBJECTS) : cfgdll.cfg 33 | 34 | # Compiler configuration files 35 | cfgdll.cfg : makefile.bc 36 | Copy &&| 37 | $(CFLAGS) 38 | | $@ 39 | 40 | 41 | # Remove all generated files 42 | clean: 43 | -@erase *.exe 44 | -@erase *.lib 45 | -@erase *.dll 46 | -@erase *.obj 47 | -@erase *.cfg 48 | -@erase *.map 49 | 50 | -------------------------------------------------------------------------------- /Extras/wrappers/wrapptrs.def: -------------------------------------------------------------------------------- 1 | EXPORTS 2 | wrapptrs__init=_wrapptrs__init 3 | -------------------------------------------------------------------------------- /Extras/wrappers/wrapptrs.exp: -------------------------------------------------------------------------------- 1 | wrapptrs__init 2 | -------------------------------------------------------------------------------- /Makefile.in: -------------------------------------------------------------------------------- 1 | ############################################################################## 2 | ############################################################################## 3 | ## 4 | ## Configuration Parameters 5 | ## 6 | ############################################################################## 7 | ############################################################################## 8 | # 9 | # XLSLIB -- directory for xlisp executable, startup, example, and help files 10 | # BINDIR -- directory for xlispstat shell script 11 | # 12 | 13 | prefix = @prefix@ 14 | exec_prefix = @exec_prefix@ 15 | 16 | XLSLIB=${prefix}/lib/xlispstat 17 | BINDIR=${exec_prefix}/bin 18 | 19 | SHELL = /bin/sh 20 | 21 | ############################################################################### 22 | ############################################################################### 23 | ### ### 24 | ### DO NOT EDIT BELOW THIS LINE ### 25 | ### ### 26 | ############################################################################### 27 | ############################################################################### 28 | 29 | XLSINCDIR = src/include 30 | LSPDIR = src/lsp 31 | CDIR = src/c 32 | 33 | LIBS = ${EXTRALIBS} -lm 34 | 35 | xlispstat: setup.shell xlisp.wks 36 | ./setup.shell xlispstat ${XLSLIB} 37 | chmod a+x xlispstat 38 | 39 | xlisp.wks: xlisp ${LSPDIR}/xlisp.wks 40 | rm -f xlisp.wks 41 | cp ${LSPDIR}/xlisp.wks xlisp.wks 42 | ${LSPDIR}/xlisp.wks: 43 | (cd ${LSPDIR}; ${MAKE} xlisp.wks) 44 | 45 | xlisp: ${CDIR}/xlisp 46 | rm -f xlisp 47 | cp ${CDIR}/xlisp ./xlisp 48 | ${CDIR}/xlisp: 49 | (cd ${CDIR}; make xlisp) 50 | 51 | install: installexecs installlsp 52 | 53 | installexecs: xlispstat xlisp installdirs 54 | -cp xlispstat ${BINDIR}/xlispstat 55 | -cp xlisp ${XLSLIB} 56 | 57 | installlsp: xlisp.wks xlisp.hlp installdirs 58 | -cp xlisp.wks ${XLSLIB} 59 | -cp xlisp.hlp ${XLSLIB} 60 | -cp Autoload/_autoidx.lsp Autoload/*.fsl ${XLSLIB}/Autoload 61 | -cp Data/*.lsp ${XLSLIB}/Data 62 | -cp Examples/*.lsp ${XLSLIB}/Examples 63 | 64 | installdirs: 65 | -mkdir -p ${BINDIR} 66 | -mkdir -p ${XLSLIB} 67 | -mkdir ${XLSLIB}/Data 68 | -mkdir ${XLSLIB}/Examples 69 | -mkdir ${XLSLIB}/Autoload 70 | 71 | clean: 72 | rm -f *~ Autoload/*.fsl 73 | (cd ${CDIR}; ${MAKE} clean) 74 | (cd ${LSPDIR}; ${MAKE} clean) 75 | 76 | cleanall: clean 77 | rm -f xlisp xlisp.wks xlispstat shlibconfig.sh 78 | (cd ${CDIR}; ${MAKE} cleanall) 79 | (cd ${LSPDIR}; ${MAKE} cleanall) 80 | 81 | distclean: cleanall 82 | rm -f config.cache config.status config.log Makefile 83 | rm -f src/include/xlconfig.h 84 | (cd ${CDIR}; ${MAKE} distclean) 85 | (cd ${LSPDIR}; ${MAKE} distclean) 86 | -------------------------------------------------------------------------------- /aclocal.m4: -------------------------------------------------------------------------------- 1 | define(XLS_CHECK_DEFINE, 2 | [echo checking for $1 3 | AC_PROGRAM_EGREP(yes, 4 | [#ifdef $1 5 | yes 6 | #endif 7 | ], $2) 8 | ])dnl 9 | -------------------------------------------------------------------------------- /doc/README: -------------------------------------------------------------------------------- 1 | This directory contains some documentation files for XLISP and 2 | XLISP-STAT. Currently, these files are 3 | 4 | changes.tex Changes from Release 2 5 | changes.ind Index for changes.tex 6 | changes.ps PostScript version of changes.tex 7 | glim.tex Documentation for generalized linear models system 8 | xlispdoc.txt Manual for XLISP 2.1g, text form 9 | xlispdoc.ps Manual for XLISP 2.1g, PostScript form 10 | xlispins.doc Documentation on XLISP internals 11 | 12 | -------------------------------------------------------------------------------- /doc/xlispdoc.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jhbadger/xlispstat/f1bea6053df658ee48612bf1f63c35de99e2c649/doc/xlispdoc.txt -------------------------------------------------------------------------------- /emacs/README.exls: -------------------------------------------------------------------------------- 1 | NOTE: For emacs 19, use the file xlispstat19.el instead of xlispstat.el 2 | 3 | The exls shell script runs xlispstat.beta under GNU emacs. This 4 | provides parenthesis matching and indentation, by hitting the tab key. 5 | Two things may take some getting used to: 6 | 7 | control characters, such as C-c (-c), need an extra C-c 8 | prefix. The main ones are 9 | 10 | C-c C-c interrupt (two C-c's instead of one) 11 | C-c C-d eof to quit (or use (exit)) 12 | C-c C-u kill input line 13 | 14 | xterm scrolling is not available, but you can scrollusing emacs 15 | commands (here M-x means x): 16 | 17 | M-v back one screen 18 | C-v forward one screen 19 | M-< to beginning of buffer 20 | M-> to end of buffer 21 | 22 | C-p previous line 23 | C-n next line 24 | C-f forward one character 25 | C-b backward one character 26 | 27 | There are many other command available, but these should do for starters. 28 | A few emergency hints: 29 | 30 | If you accidentally hit some key combination that confuses emacs, 31 | C-g will usually fix things again. 32 | 33 | If the screen is split into several windows, C-xo moves to the next 34 | window. C-x1 deletes all but the current window. 35 | 36 | If all else fails, C-x C-c should kill emacs and let you out 37 | 38 | -------------------------------------------------------------------------------- /emacs/exls: -------------------------------------------------------------------------------- 1 | #! /bin/csh -f 2 | emacs -l /usr/local/lib/xlispstat.el -f run-xlispstat-exit 3 | -------------------------------------------------------------------------------- /emacs/my.emacs: -------------------------------------------------------------------------------- 1 | ;; functions for running an inferior xlispstat process 2 | 3 | (autoload 'run-xlispstat "/usr/sun1/luke/lib/xlispstat" 4 | "Run inferior xlispstat process" t) 5 | (autoload 'run-kcl "/usr/sun1/luke/lib/xlispstat" 6 | "Run inferior kcl process" t) 7 | 8 | (global-set-key "\C-xg" 'goto-line) 9 | (global-set-key "\C-xd" 'lisp-send-defun) 10 | (global-set-key "\C-xj" 'lisp-send-defun-and-go) 11 | -------------------------------------------------------------------------------- /emacs/xlispstat19.el: -------------------------------------------------------------------------------- 1 | ;; Running an inferior xlispstat process under GNU Emacs 19.19 2 | 3 | (require 'inf-lisp) 4 | 5 | (defun xlisp-quit-sentinel (proc reason) 6 | (if (and (not (memq reason '(run stop)))) 7 | (save-buffers-kill-emacs))) 8 | 9 | (defun set-xlisp-sentinel () 10 | (let ((process (inferior-lisp-proc))) 11 | (set-process-sentinel process 'xlisp-quit-sentinel) 12 | (process-kill-without-query process))) 13 | 14 | (defun run-xlispstat-exit () 15 | (run-xlispstat) 16 | (set-xlisp-sentinel)) 17 | 18 | (defun run-xlispstat () 19 | "Run an inferior xlispstat process." 20 | (interactive) 21 | (inferior-lisp "xlispstat")) 22 | 23 | (defun run-kcl-exit () 24 | (run-kcl) 25 | (set-xlisp-sentinel)) 26 | 27 | (defun run-kcl () 28 | (interactive) 29 | (inferior-lisp "kcl")) 30 | 31 | -------------------------------------------------------------------------------- /setup.shell: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | cat > $1 <<+++ 3 | #!/bin/sh 4 | XLISPLIB=$2 export XLISPLIB 5 | if test -f xlisp.wks; then WKS="xlisp.wks"; 6 | else WKS="\${XLISPLIB}/xlisp.wks"; 7 | fi 8 | if test -f xlisp; then XLISP=xlisp; 9 | else XLISP="\${XLISPLIB}/xlisp" 10 | fi 11 | exec \${XLISP} -w\${WKS} \$* 12 | +++ 13 | 14 | -------------------------------------------------------------------------------- /shlibconfig.sh.in: -------------------------------------------------------------------------------- 1 | # This sh shell script (adapted form Tcl 8.0's tclConfig.sh) is 2 | # generated automatically by the configure script. It will create 3 | # shell variables for the configuration variables needed for shared 4 | # libraries. 5 | 6 | # C compiler to use for compilation. 7 | CC='@CC@' 8 | 9 | # Flags to pass to cc when compiling the components of a shared library: 10 | SHLIB_CFLAGS='@SHLIB_CFLAGS@' 11 | 12 | # Base command to use for combining object files into a shared library: 13 | SHLIB_LD='@SHLIB_LD@' 14 | 15 | # Libraries, if any, to be included when linking shared libraries: 16 | SHLIB_LD_LIBS='@SHLIB_LD_LIBS@' 17 | 18 | -------------------------------------------------------------------------------- /src/c/cholesky.c: -------------------------------------------------------------------------------- 1 | /* choldecomp - Cholesky decomposition routines. */ 2 | /* XLISP-STAT 2.1 Copyright (c) 1990, by Luke Tierney */ 3 | /* Additions to Xlisp 2.1, Copyright (c) 1989 by David Michael Betz */ 4 | /* You may give out copies of this software; for conditions see the */ 5 | /* file COPYING included with this distribution. */ 6 | 7 | #include "xlisp.h" 8 | #include "xlstat.h" 9 | #include "linalg.h" 10 | 11 | /* forward declarations */ 12 | LOCAL double Max P2H(double, double); 13 | 14 | LOCAL double Max P2C(double, a, double, b) 15 | { 16 | return(a > b ? a : b); 17 | } 18 | 19 | #define Dot(n, x, y) blas_ddot(n, x, 1, y, 1) 20 | 21 | VOID choldecomp P4C(double *, a, int, n, double, maxoffl, double *, maxadd) 22 | { 23 | double minl, minljj, minl2; 24 | int i, j; 25 | int in, jn; 26 | 27 | minl = pow(macheps(), 0.25) * maxoffl; 28 | minl2 = 0.0; 29 | 30 | if (maxoffl == 0.0) { 31 | for (i = 0; i < n; i++) { 32 | int ii = i * n + i; 33 | maxoffl = Max(fabs(a[ii]), maxoffl); 34 | } 35 | maxoffl = sqrt(maxoffl); 36 | minl2 = sqrt(macheps()) * maxoffl; 37 | } 38 | 39 | *maxadd = 0.0; 40 | for (j = 0, jn = 0; j < n; j++, jn += n) { 41 | int jj = jn + j; 42 | a[jj] -= Dot(j, a + jn, a + jn); 43 | 44 | minljj = 0.0; 45 | 46 | for (i = j + 1, in = (j + 1) * n; i < n; i++, in += n) { 47 | int ij = in + j; 48 | int ji = jn + i; 49 | a[ij] = a[ji]; 50 | a[ij] -= Dot(j, a + in, a + jn); 51 | minljj = Max(fabs(a[ij]), minljj); 52 | } 53 | 54 | minljj = Max(minljj / maxoffl, minl); 55 | 56 | if (a[jj] > minljj * minljj) a[jj] = sqrt(a[jj]); 57 | else { 58 | if (minljj < minl2) minljj = minl2; 59 | *maxadd = Max(*maxadd, minljj * minljj - a[jj]); 60 | a[jj] = minljj; 61 | } 62 | 63 | /**** use BLAS dscal */ 64 | for (i = j + 1, in = (j + 1) * n; i < n; i++, in += n) { 65 | int ij = in + j; 66 | a[ij] /= a[jj]; 67 | } 68 | } 69 | 70 | for (i = 0, in = 0; i < n; i++, in += n) { 71 | for (j = i + 1; j < n; j++) { 72 | int ij = in + j; 73 | a[ij] = 0.0; 74 | } 75 | } 76 | } 77 | -------------------------------------------------------------------------------- /src/c/foo.c: -------------------------------------------------------------------------------- 1 | foo(n, x, sum) 2 | int *n; 3 | double *x, *sum; 4 | { 5 | int i; 6 | 7 | for (i = 0, *sum = 0.0; i < *n; i++) { 8 | *sum += x[i]; 9 | } 10 | } 11 | -------------------------------------------------------------------------------- /src/c/kernel.c: -------------------------------------------------------------------------------- 1 | #include "xlisp.h" 2 | #include "xlstat.h" 3 | 4 | #ifndef ROOT2PI 5 | #define ROOT2PI 2.50662827463100050241 6 | #endif 7 | 8 | static double kernel P4C(double, x, double, y, double, w, int, type) 9 | { 10 | double z, k; 11 | 12 | if (w > 0.0) { 13 | z = (x - y) / w; 14 | switch (type) { 15 | case 'B': 16 | w = 2.0 * w; 17 | z = 0.5 * z; 18 | if (-0.5 < z && z < 0.5) { 19 | z = (1.0 - 4 * z * z); 20 | k = 15.0 * z * z / 8.0; 21 | } 22 | else k = 0.0; 23 | break; 24 | case 'G': 25 | w = 0.25 * w; 26 | z = 4.0 * z; 27 | k = exp(- 0.5 * z * z) / ROOT2PI; 28 | break; 29 | case 'U': 30 | w = 1.5 * w; 31 | z = .75 * z; 32 | k = (fabs(z) < 0.5) ? 1.0 : 0.0; 33 | break; 34 | case 'T': 35 | if (-1.0 <= z && z < 0.0) k = 1.0 + z; 36 | else if (0.0 <= z && z < 1.0) k = 1.0 - z; 37 | else k = 0.0; 38 | break; 39 | default: k = 0.0; break; 40 | } 41 | k = k / w; 42 | } 43 | else k = 0.0; 44 | 45 | return(k); 46 | } 47 | 48 | int kernel_smooth P10C(double *, x, double *, y, int, n, double, width, 49 | double *, wts, double *, wds, double *, xs, double *, ys, 50 | int, ns, int, ktype) 51 | { 52 | int i, j; 53 | double wsum, ysum, lwidth, lwt, xmin, xmax; 54 | 55 | if (n < 1) return(1); 56 | if (width <= 0.0) { 57 | if (n < 2) return(1); 58 | for (xmin = xmax = x[0], i = 1; i < n; i++) { 59 | if (xmin > x[i]) xmin = x[i]; 60 | if (xmax < x[i]) xmax = x[i]; 61 | } 62 | width = (xmax - xmin) / (1 + log((double) n)); 63 | } 64 | 65 | for (i = 0; i < ns; i++) { 66 | for (j = 0, wsum = 0.0, ysum = 0.0; j < n; j++) { 67 | lwidth = (wds != NULL) ? width * wds[j] : width; 68 | lwt = kernel(xs[i], x[j], lwidth, ktype); 69 | if (wts != NULL) lwt *= wts[j]; 70 | wsum += lwt; 71 | if (y != NULL) ysum += lwt * y[j]; 72 | } 73 | if (y != NULL) ys[i] = (wsum > 0.0) ? ysum / wsum : 0.0; 74 | else ys[i] = wsum / n; 75 | } 76 | return(0); 77 | } 78 | 79 | -------------------------------------------------------------------------------- /src/c/machines/README: -------------------------------------------------------------------------------- 1 | The subdirectories in this directory contain include files and 2 | additional instructions for building XLISP-STAT on several machines. 3 | -------------------------------------------------------------------------------- /src/c/machines/aix/dynload/Makefile: -------------------------------------------------------------------------------- 1 | # %W% revision of %E% %U% 2 | # This is an unpublished work copyright (c) 1992 Helios Software GmbH 3 | # 3000 Hannover 1, West Germany 4 | 5 | SHELL=/bin/sh 6 | IPATH= 7 | DEFS= 8 | DEBUGFLAGS=-g -DDEBUG 9 | NODEBUGFLAGS=-O 10 | CFLAGS=$(IPATH) $(DEFS) $(NODEBUGFLAGS) 11 | TARGETS=libdl.a 12 | DEST=/usr/local/lib 13 | HDRS=dlfcn.h 14 | SRCS=dlfcn.c 15 | OBJS=$(SRCS:%.c=%.o) 16 | 17 | all: $(TARGETS) dlfcn.c 18 | 19 | $(TARGETS): shr.o 20 | ar rv $@ $? 21 | 22 | dlfcn.o: dlfcn.h 23 | 24 | shr.o: $(OBJS) dl.exp 25 | $(CC) -o $@ $(OBJS) -bE:dl.exp -bM:SRE -e _nostart -lld 26 | 27 | lint: 28 | lint $(IPATH) $(DEFS) $(SRCS) >lintout 29 | 30 | info: 31 | sccs info 32 | 33 | clean: 34 | rm -f lintout a.out core *.o *-lg *% *~ tags deps% 35 | 36 | clobber: clean 37 | rm -f $(TARGETS) deps 38 | 39 | install: all 40 | cp $(TARGETS) $(DEST) 41 | 42 | shar: 43 | shar README Makefile dlfcn.h dlfcn.c dl.exp dltest.c >dl.shar 44 | -------------------------------------------------------------------------------- /src/c/machines/aix/dynload/dl.exp: -------------------------------------------------------------------------------- 1 | #!/usr/local/lib/libdl.a 2 | dlopen 3 | dlclose 4 | dlsym 5 | dlerror 6 | -------------------------------------------------------------------------------- /src/c/machines/aix/dynload/dlfcn.h: -------------------------------------------------------------------------------- 1 | /* 2 | * @(#)dlfcn.h 1.3 revision of 92/12/27 20:58:32 3 | * This is an unpublished work copyright (c) 1992 Helios Software GmbH 4 | * 3000 Hannover 1, Germany 5 | */ 6 | 7 | /* 8 | * Mode flags for the dlopen routine. 9 | */ 10 | #define RTLD_LAZY 1 11 | #define RTLD_NOW 2 12 | 13 | /* 14 | * To be able to intialize, a library may provide a dl_info structure 15 | * that contains functions to be called to initialize and terminate. 16 | */ 17 | struct dl_info { 18 | void (*init)(void); 19 | void (*fini)(void); 20 | }; 21 | 22 | #if __STDC__ || defined(_IBMR2) 23 | void *dlopen(const char *path, int mode); 24 | void *dlsym(void *handle, const char *symbol); 25 | char *dlerror(void); 26 | int dlclose(void *handle); 27 | #else 28 | void *dlopen(); 29 | void *dlsym(); 30 | char *dlerror(); 31 | int dlclose(); 32 | #endif 33 | -------------------------------------------------------------------------------- /src/c/machines/aix/foo.exp: -------------------------------------------------------------------------------- 1 | foo 2 | -------------------------------------------------------------------------------- /src/c/machines/aix/xlisp.exp: -------------------------------------------------------------------------------- 1 | #! ./xlisp 2 | xadd 3 | xadd1 4 | xmul 5 | -------------------------------------------------------------------------------- /src/c/machines/alpha/README: -------------------------------------------------------------------------------- 1 | configure set things up properly on 2 | 3 | uname -a => OSF1 jupiter.stat.wisc.edu V1.3 111 alpha 4 | 5 | To compile on an Alpha running OSF/1 I used 6 | 7 | GRAPHSYS = X11WINDOWS 8 | X11INCDIR_FLAG= 9 | X11LIBDIR_FLAG= 10 | 11 | UCFLAGS = -O -std -ieee_with_no_inexact -Olimit 2000 12 | ULDFLAGS = 13 | 14 | EXTRALIBS= -ldnet_stub 15 | EXTRAOBJS= 16 | 17 | IEEE_FLAG=-DIEEEFP 18 | ANSI_FLAG=-DANSI 19 | 20 | FOREIGN_FLAG = -DFOREIGNCALL 21 | FOREIGN_FILE = sysvr4-foreign.h 22 | 23 | CC = cc 24 | LDCC = $(CC) 25 | 26 | 27 | You can also use -ieee_with_inecact, but floating point performance 28 | seems quite a bit slower. Using neither ieee option may give slightly 29 | better performance, but you have to turn off IEEE_FLAG and don't get 30 | proper ieee handling of infinities, etc.. 31 | 32 | To compile with gcc, I think you also need to turn IEEE_FLAG off, 33 | unless there is some way to tell gcc to do th equivalent of 34 | -ieee_with_no_inexact. 35 | 36 | Dynamic loading is done using shared libraries. To make the example in 37 | foo.c into a shared library, compile it with cc -c foo.c and then do 38 | 39 | ld -shared -o libfoo.so foo.o -lc 40 | 41 | You can then use (dyn-load "libfoo.so"). You may need to use 42 | "./libfoo.so" if the current directory isn't on your library search 43 | path. 44 | -------------------------------------------------------------------------------- /src/c/machines/cray/README: -------------------------------------------------------------------------------- 1 | configure got things to work on 2 | 3 | uname -a => sf sf 7.C.3 06.16 CRAY Y-MP 4 | 5 | I compiled xlispstat on a Cray Y-MP with the settings 6 | 7 | GRAPHSYS = X11WINDOWS 8 | X11INCDIR_FLAG= 9 | X11LIBDIR_FLAG= 10 | 11 | UCFLAGS = -O -h tolerant -DHZ=CLK_TCK -DCRAYCC 12 | ULDFLAGS = 13 | 14 | EXTRALIBS= 15 | EXTRAOBJS= 16 | 17 | IEEE_FLAG= 18 | ANSI_FLAG=-DANSI 19 | 20 | FOREIGN_FLAG = 21 | FOREIGN_FILE = dummy-foreign.h 22 | 23 | CC = cc 24 | LDCC = $(CC) 25 | -------------------------------------------------------------------------------- /src/c/machines/decstation/README: -------------------------------------------------------------------------------- 1 | For DECstation information, see the information in the `pmax' directory. 2 | -------------------------------------------------------------------------------- /src/c/machines/encore/README: -------------------------------------------------------------------------------- 1 | It may be possible to make this code work with the current version of 2 | xlispstat -- we no longer have one of these systems for me to test 3 | things on. 4 | 5 | This directory contains the foreign function calling include file for 6 | an Encore Multimacs (or whatever it is called). This system does not 7 | have ld -A but it does have its own dynloading routine. To compile with 8 | this stuff 9 | 10 | 1) add -lld to the EXTRALIBS make variable 11 | 2) add -Dhash=HXSH to the UCFLAGS variable 12 | 13 | The second item is neeeded because the ld library contains a global 14 | function called hash which conflicts with the global hash function in 15 | xlisp. 16 | 17 | You may also want to edit the foreign.h file to include your own libraries 18 | to search in the loading process. At present there is no easy way to 19 | specify a library from the Lisp level; I will add this sometime. 20 | -------------------------------------------------------------------------------- /src/c/machines/epix/README: -------------------------------------------------------------------------------- 1 | This is one weird box. The configure script required some major 2 | hacking. On the U of Mn's box running UMIPS 1.4.3 I used the 3 | following, and set up configure to reproduce these settings. My 4 | defaults were bsd43; if you use sysv defaults you may need to do set 5 | CC to 'cc -systype bsd43'. 6 | 7 | GRAPHSYS = X11WINDOWS 8 | X11INCDIR_FLAG = -I/usr/RISCwindows4.0/include 9 | X11LIBDIR_FLAG = -L/usr/RISCwindows4.0/lib 10 | 11 | UCFLAGS = -O -Olimit 2000 -DMEMMOVE=memcpy -DNODIFFTIME 12 | ULDFLAGS = -Wl,-D -Wl,c00000 13 | 14 | EXTRALIBS = -lmld 15 | EXTRAOBJS = isnan.o getcwd.o remove.o ctype.o 16 | 17 | IEEE_FLAG = -DIEEEFP 18 | ANSI_FLAG = -DANSI 19 | 20 | FOREIGN_FLAG = -DFOREIGNCALL 21 | FOREIGN_FILE = epix-foreign.h 22 | 23 | CC = cc 24 | LDCC = $(CC) 25 | 26 | The configure script also digs the three files getcwd.o, remove.o, 27 | ctype.o out of /lib/libc.a. I have no idea why i needed to do this 28 | instead of putting -lc in as the last library to search, but doing 29 | that causes crashes. 30 | 31 | Finally, configure copies isnan.c from this directory to the main 32 | source directory. 33 | 34 | Dynamic loading seems to work, but requires compiling the code to be 35 | loaded with -G. 36 | -------------------------------------------------------------------------------- /src/c/machines/epix/isnan.c: -------------------------------------------------------------------------------- 1 | #ifdef IEEEFP 2 | #define IEEELO 1 3 | #define IEEEHI 0 4 | 5 | #define UINT32 unsigned long 6 | 7 | #define ieeehi(x) ((UINT32 *)(&(x)))[IEEEHI] 8 | #define ieeelo(x) ((UINT32 *)(&(x)))[IEEELO] 9 | 10 | int isnan(x) 11 | double x; 12 | { 13 | return (((ieeehi(x) & 0x7FF00000L) == 0x7FF00000L) 14 | && ((ieeehi(x) & 0xFFFFFL) != 0 || ieeelo(x) != 0)); 15 | } 16 | #endif /* IEEEFP */ 17 | -------------------------------------------------------------------------------- /src/c/machines/generic/README: -------------------------------------------------------------------------------- 1 | This is for systems without dynamic loading support. Use 2 | 3 | FOREIGN_FLAG= 4 | FOREIGN_FILE=dummy-foreign.h 5 | 6 | For generic systems you should only need to decide whether to turn on 7 | the ANSI and IEEE flags. If your system has an ansi C compiler, use 8 | 9 | ANSI_FLAG = -DANSI 10 | 11 | Otherwise use 12 | 13 | ANSI_FLAG = 14 | 15 | If your system has IEEE 754 arithmetic and provides the functions 16 | `finite' and `isnan' in its math library (or some other library), 17 | use 18 | 19 | IEEE_FLAG = -DIEEEFP 20 | 21 | Otherwise use 22 | 23 | IEEE_FLAG = 24 | 25 | The configure script may be able to set this up for you. 26 | 27 | If you want dynamic loading and have a system that is not directly 28 | supported in the machines directory, check whether your system has 29 | shared libraries and, if so, whether there is a programmer's interface 30 | that let's you load a library and find a symbol's address in the 31 | library. If so, it should not be too hard. Look at what is done for 32 | hpux and for alpha, irix and solaris. 33 | 34 | -------------------------------------------------------------------------------- /src/c/machines/hpux/README: -------------------------------------------------------------------------------- 1 | Configure set things up properly on 2 | 3 | uname -a => HP-UX desire A.09.01 A 9000/715 2015081272 two-user license 4 | 5 | To compile with cc on a snake with HPUX 9.0 I used 6 | 7 | GRAPHSYS = X11WINDOWS 8 | X11INCDIR_FLAG= 9 | X11LIBDIR_FLAG= 10 | 11 | UCFLAGS = -O -Aa -D_HPUX_SOURCE 12 | ULDFLAGS = -Wl,-E 13 | 14 | EXTRALIBS=-ldld 15 | EXTRAOBJS= 16 | 17 | IEEE_FLAG=-DIEEEFP 18 | ANSI_FLAG=-DANSI 19 | 20 | FOREIGN_FLAG = -DFOREIGNCALL 21 | FOREIGN_FILE = hpux-foreign.h 22 | 23 | CC = cc 24 | LDCC = $(CC) 25 | 26 | 27 | Dynamic loading uses the shared library mechanism. To load the 28 | example function in foo.c, compile foo.c with the +z or +Z flags and 29 | then create a shared object, say, libfoo.so with 30 | 31 | ld -o libfoo.so -b foo.o 32 | 33 | Then load using (dyn-load "libfoo.so"). 34 | 35 | If you build the system with gcc, make sure you get the math library 36 | that includes the `finite' function. 37 | -------------------------------------------------------------------------------- /src/c/machines/hpux/dlfcn/dlfcn.h: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | #define RTLD_LAZY (BIND_DEFERRED | BIND_NONFATAL) 4 | #define RTLD_NOW BIND_IMMEDIATE 5 | 6 | void *dlopen(const char *, int); 7 | void *dlsym(void *, const char *); 8 | int dlclose(void *); 9 | char *dlerror(void); 10 | 11 | -------------------------------------------------------------------------------- /src/c/machines/ibmrt_bsd/foreign.h: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | #define STDBSD 4 | #define SYM_IS_GLOBAL_FUNCTION(ldptr,symbol) \ 5 | (((symbol).n_type & N_TYPE) == N_DATA && ((symbol).n_type & N_EXT)) 6 | 7 | #define INTERNAL_CNAME_PATTERN "_%s" 8 | #define INTERNAL_FNAME_PATTERN "_%s_" 9 | #define CLIBS "-lm -lc" 10 | #define FLIBS "-lm -lc -lF77 -lI77 -lU77" 11 | #define LDPATTERN "ld -d -N -x -A %s -T %x %s %s %s -o %s" 12 | #define TMPPATTERN "/tmp/xlispdyn%d" 13 | #define TMPNAMESIZE 32 14 | #define PAGE_SIZE 4096 15 | #define MIN_ALLOC 10000 + PAGE_SIZE 16 | #define VERBDFLT TRUE 17 | -------------------------------------------------------------------------------- /src/c/machines/ibmrt_bsd/xsdynload.patch: -------------------------------------------------------------------------------- 1 | *** xsdynload.c.orig Sun Oct 29 10:46:48 1989 2 | --- xsdynload.c Fri Jan 19 14:18:12 1990 3 | *************** 4 | *** 106,112 **** 5 | --- 106,119 ---- 6 | for (i = 0, data = x; i < a.size; i++) { 7 | elem = getnextelement(&data, i); 8 | if (a.type == IN) ((int *) a.addr)[i] = getfixnum(elem); 9 | + #if !(defined(ibm032) && defined(__HIGHC__)) 10 | else ((double *) a.addr)[i] = makedouble(elem); 11 | + #else /* avoid bug in hc 2.1n C compiler on IBM RT running AOS 4.3 */ 12 | + else { 13 | + double *dbl = &((double *)a.addr)[i] ; 14 | + *dbl = makedouble(elem) ; 15 | + } 16 | + #endif 17 | } 18 | 19 | xlpop(); 20 | *************** 21 | *** 364,371 **** 22 | --- 371,380 ---- 23 | 24 | #ifdef STDBSD 25 | #define SYMVALUE(sym) ((char *) ((sym).n_value)) 26 | + #ifndef SYM_IS_GLOBAL_FUNCTION 27 | #define SYM_IS_GLOBAL_FUNCTION(ldptr,symbol) \ 28 | (((symbol).n_type & N_TYPE) == N_TEXT && ((symbol).n_type & N_EXT)) 29 | + #endif /* SYM_IS_GLOBAL_FUNCTION */ 30 | #endif STDBSD 31 | 32 | /* DYN-LOAD function */ 33 | -------------------------------------------------------------------------------- /src/c/machines/irix/README: -------------------------------------------------------------------------------- 1 | configure set things up for dynamic loading on 2 | 3 | uname -a => IRIX demo 5.2 04091117 IP22 mips 4 | 5 | To compile with cc I used 6 | 7 | GRAPHSYS = X11WINDOWS 8 | X11INCDIR_FLAG= 9 | X11LIBDIR_FLAG= 10 | 11 | UCFLAGS = -O -Olimit 2000 12 | ULDFLAGS = 13 | 14 | EXTRALIBS=-ldl 15 | EXTRAOBJS= 16 | 17 | IEEE_FLAG=-DIEEEFP 18 | ANSI_FLAG=-DANSI 19 | 20 | FOREIGN_FLAG = -DFOREIGNCALL 21 | FOREIGN_FILE = sysvr4-foreign.h 22 | 23 | CC = cc 24 | LDCC = $(CC) 25 | 26 | 27 | Dynamic loading uses the shared library machanism. To load the example 28 | foo.c, compile foo.c with 29 | 30 | cc -c foo.c 31 | 32 | then do 33 | 34 | ld -o libfoo.so -shared foo.o 35 | 36 | Then you can load with (dyn-load "libfoo.so"). You may have to make 37 | sure the current directory is in your library search path for this to 38 | work. 39 | -------------------------------------------------------------------------------- /src/c/machines/linux/README: -------------------------------------------------------------------------------- 1 | configure set things up properly on a RedHat ELF box, 2 | 3 | [luke@owasso]$ uname -a 4 | Linux owasso.stat.umn.edu 1.2.13 #3 Thu Aug 15 06:54:53 CDT 1996 i486 5 | 6 | The parameters it produces are 7 | 8 | GRAPHSYS = X11WINDOWS 9 | X11INCDIR_FLAG = -I/usr/X11R6/include 10 | X11LIBDIR_FLAG = -L/usr/X11R6/lib 11 | 12 | UCFLAGS = -O 13 | ULDFLAGS = 14 | 15 | EXTRALIBS = -lieee -ldl 16 | EXTRAOBJS= 17 | 18 | IEEE_FLAG=-DIEEEFP 19 | ANSI_FLAG=-DANSI 20 | 21 | FOREIGN_FLAG = 22 | FOREIGN_FILE = sysvr4-foreign.h 23 | 24 | CC = cc 25 | LDCC = $(CC) 26 | 27 | Dynamic loading on ELF systems is done using shared libraries. To make 28 | the example in foo.c into a shared library, compile it with cc -c 29 | foo.c and then do 30 | 31 | ld -shared -o libfoo.so foo.o 32 | 33 | You can then use (dyn-load "libfoo.so"). You may need to use 34 | "./libfoo.so" if the current directory isn't on your library search 35 | path. 36 | -------------------------------------------------------------------------------- /src/c/machines/pmax/README: -------------------------------------------------------------------------------- 1 | On a Decstation 3100 running Ultrix 4.2a, 2 | 3 | uname -a => ULTRIX nokomis.stat.umn.edu 4.2 0 RISC 4 | 5 | and release 3.35 the following worked. The configure shell script 6 | should set up a Makefile with these settings: 7 | 8 | GRAPHSYS = X11WINDOWS 9 | X11INCDIR_FLAG = 10 | X11LIBDIR_FLAG = 11 | 12 | UCFLAGS = -O -Olimit 2000 13 | ULDFLAGS = -Wl,-D -Wl,c00000 14 | 15 | EXTRALIBS = 16 | EXTRAOBJS = 17 | 18 | IEEE_FLAG = -DIEEEFP 19 | ANSI_FLAG = 20 | 21 | FOREIGN_FLAG = -DFOREIGNCALL 22 | FOREIGN_FILE = pmax-foreign.h 23 | 24 | CC = cc 25 | LDCC = $(CC) 26 | 27 | You need -Olimit 2000 to insure the byte code interpreter is 28 | optimized, use. 29 | 30 | Dynamic loading is supported. Code that is to be loaded dynamically 31 | must be compiled with the `-G 0' flag. 32 | 33 | If you want to display xlispstat on a DECstation running ULTRIX 4.0 34 | you may run into two bugs in the ULTRIX X servers: 35 | 36 | On monochrome 3100's plot-points produces strange-looking 37 | symbols. This is caused by a bug in the server response to an 38 | XDrawPoints request. 39 | 40 | On greyscale 5000's (and possibly other machines) exiting 41 | from xlispstat causes an infinite loop of error messages. 42 | This is due to a bug in handling XFreeColor requests. 43 | 44 | To fix these problems, uncomment the defines of the variables 45 | SERVER_COLOR_FREE_PROBLEM and DRAWPOINTSBUG in the file 46 | StX11options.h. 47 | 48 | If you plan on using DEC's dxwm window manager there is another 49 | problem: modal dialog windows do not appear. This seems to be due to 50 | lack of ICCCM compliance in dxwm (and improper ICCCM compliance in 51 | xlispstat). You can cure this by turning ICCCM compliance off in 52 | xlispstat. You can do this in three ways: 53 | 54 | 1) You can set USE_ICCCM_DEFAULT to FALSE in StX11options.h and 55 | recompile the system. 56 | 57 | 2) You can set the icccm resource to off with a line like 58 | 59 | xlisp*icccm: off 60 | 61 | in the .Xdefaults file 62 | 63 | 3) You can use the expression 64 | 65 | (x11-options :icccm nil) 66 | 67 | in xlispstat. 68 | 69 | If you are only going to use xlispstat on DECstations runing dxwm then 70 | 1) is probably the simplest choice. If you may display xlispstat on 71 | other workstations or other window managers then it may be better to 72 | set the icccm resource in a resource file used when dxwm starts up. 73 | 74 | The version of StX11options.h provided in this directory here should 75 | work for a DECstation running Ultrix 4.0 and the dxwm window manager. 76 | -------------------------------------------------------------------------------- /src/c/machines/pmax/StX11options.h: -------------------------------------------------------------------------------- 1 | /* StX11options - X11 compile options */ 2 | /* XLISP-STAT 2.1 Copyright (c) 1990, by Luke Tierney */ 3 | /* Additions to Xlisp 2.1, Copyright (c) 1989 by David Michael Betz */ 4 | /* You may give out copies of this software; for conditions see the */ 5 | /* file COPYING included with this distribution. */ 6 | 7 | 8 | /* Default values for options settable by x11-options. Values should */ 9 | /* be TRUE or FALSE. */ 10 | 11 | #define USE_FAST_LINES_DEFAULT TRUE 12 | #define USE_FAST_SYMBOLS_DEFAULT TRUE 13 | #define MOTION_SYNC_DEFAULT TRUE 14 | #define DO_CLIPPING_DEFAULT TRUE 15 | #define USE_ICCCM_DEFAULT FALSE 16 | #define WAIT_FOR_MAP_DEFAULT TRUE 17 | 18 | 19 | /* If you get X errors when you quit from xlispstat on a color or */ 20 | /* greyscale workstation this might be due to a possible server bug */ 21 | /* related to freeing color resources. Defining the preprocessor */ 22 | /* variable SERVER_COLOR_FREE_PROBLEM may help. */ 23 | 24 | #define SERVER_COLOR_FREE_PROBLEM 25 | 26 | /* On Ultrix 4.0 there is a bug in the Xmfb server's handling of the */ 27 | /* XDrawPoints request used in drawing fast symbols. To enable a */ 28 | /* workaround define the preprocessor variable DRAWPOINTSBUG. */ 29 | 30 | #define DRAWPOINTSBUG 31 | 32 | -------------------------------------------------------------------------------- /src/c/machines/solaris/README: -------------------------------------------------------------------------------- 1 | On a Scorpion running Solaris, 2 | 3 | uname -a => SunOS laplace 5.3 Generic_101318-41 sun4d sparc 4 | 5 | I used the following. The configure shell script should set up a 6 | Makefile with these settings (except possibly for the X11 stuff, which 7 | depends on your local setup). 8 | 9 | GRAPHSYS = X11WINDOWS 10 | X11INCDIR_FLAG=-I/usr/openwin/include 11 | X11LIBDIR_FLAG=-L/usr/openwin/lib 12 | 13 | UCFLAGS = -O 14 | ULDFLAGS = 15 | 16 | EXTRALIBS=-ldl 17 | EXTRAOBJS= 18 | 19 | IEEE_FLAG=-DIEEEFP 20 | ANSI_FLAG= 21 | 22 | FOREIGN_FLAG = -DFOREIGNCALL 23 | FOREIGN_FILE = sysvr4-foreign.h 24 | 25 | CC = cc 26 | LDCC = $(CC) 27 | 28 | If you compile with the ANSI compiler cc, set CC to the appropriate 29 | name and use 30 | 31 | ANSI_FLAG=-DANSI 32 | 33 | On sun3 hardware you may want to add an appropriate floating point 34 | flag, such as -f68881, to UCFLAGS. Adding something like -fast 35 | may also be useful. 36 | 37 | Dynamic loading uses the shared library system. To load the example in 38 | foo.c, compile it with cc -c foo.c and then do 39 | 40 | ld -G -o libfoo.so foo.o 41 | 42 | to create a shared library file. Then 43 | 44 | (dyn-load "libfoo.so") 45 | 46 | should load it. You may need to use "./libfoo.o" or make sure the 47 | current directory is on the LD_LIBRARY_PATH. 48 | 49 | Anthony Rossinis suggest that to build with nonstandard X libraries 50 | you can use something, such as X11R6.3 under Solaris 2.5.x, you can 51 | 52 | make EXTRALIBS='-ldl -lsocket' LDCC='LD_RUN_PATH=/apps/X11R6.3/lib gcc' 53 | 54 | (assuming an initial configure --with-gcc --prefix=/blah/blah 55 | command, else use cc instead for the LDCC command). 56 | 57 | -------------------------------------------------------------------------------- /src/c/machines/sunos3/README: -------------------------------------------------------------------------------- 1 | I no longer have access to a Sun 3 running SunOS 3.x, so this is 2 | somewhat speculative. But I think you should be able to use the 3 | following. The configure script should set up a Makefile with these 4 | settings (except possibly for the X11 stuff which depends on your 5 | local setup): 6 | 7 | GRAPHSYS = X11WINDOWS 8 | X11INCDIR_FLAG= 9 | X11LIBDIR_FLAG= 10 | 11 | UCFLAGS = -O 12 | ULDFLAGS = -x 13 | 14 | EXTRALIBS= 15 | EXTRAOBJS= 16 | 17 | IEEE_FLAG=-DIEEEFP 18 | ANSI_FLAG= 19 | 20 | FOREIGN_FLAG = -DFOREIGNCALL 21 | FOREIGN_FILE = bsd-foreign.h 22 | 23 | CC = cc 24 | LDCC = $(CC) 25 | 26 | You may want to add an appropriate floating point flag, such as 27 | -f68881, to UCFLAGS. 28 | 29 | FOr SunOS 4.1 (and possibly 4.0) see the sunos4 directory. For Solaris 30 | see the solaris directory. If sunos4 does not work for some reason (it 31 | may not for versions before 4.1), you can use the approach used here, 32 | but you need to add 33 | 34 | -Bstatic 35 | 36 | to the ULDFLAGS variable in the Makefile to disable shared labraries. 37 | To use Sun's OpenLook vesion of X11 distributed with OS 4.1 and up 38 | you may need to use 39 | 40 | X11INCDIR_FLAG = -I/usr/openwin/include 41 | X11LIBDIR_FLAG = -L/usr/openwin/lib 42 | -------------------------------------------------------------------------------- /src/c/machines/sunos4/README: -------------------------------------------------------------------------------- 1 | The following works on SunOS 4.1, 2 | 3 | uname -a => SunOS quetelet 4.1.3 3 sun4 4 | 5 | I think it will work on 4.0 also, but if not, see the sunos3 6 | directory. The configure script should set up a Makefile with these 7 | settings (except for the X11 stuf, chich depends on your local setup). 8 | 9 | GRAPHSYS = X11WINDOWS 10 | X11INCDIR_FLAG=-I/usr/openwin/include 11 | X11LIBDIR_FLAG=-L/usr/openwin/lib 12 | 13 | UCFLAGS = -O -DMEMMOVE=memcpy 14 | ULDFLAGS = 15 | 16 | EXTRALIBS=-ldl 17 | EXTRAOBJS= 18 | 19 | IEEE_FLAG=-DIEEEFP 20 | ANSI_FLAG= 21 | 22 | FOREIGN_FLAG = -DFOREIGNCALL 23 | FOREIGN_FILE = sysvr4-foreign.h 24 | 25 | CC = cc 26 | LDCC = $(CC) 27 | 28 | The -DMEMMOVE=memcpy is a hack since memmove does not seem to be 29 | available. You do not need it on Solaris 2.0. If you compile with the 30 | ANSI compiler acc (I think that is what it is usually called, unless 31 | you have just replaces cc), use 32 | 33 | ANSI_FLAG=-DANSI 34 | CC=acc 35 | 36 | You may also be able to drop the memmove define. 37 | 38 | On sun3 hardware you may want to add an appropriate floating point 39 | flag, such as -f68881, to UCFLAGS. 40 | 41 | 42 | Dynamic loading uses the shared librayr system. To load the example in foo.c, 43 | compile it with cc -c foo.c and then do 44 | 45 | ld -o libfoo.so foo.o 46 | 47 | to create a shared library file. Then 48 | 49 | (dyn-load "libfoo.so") 50 | 51 | should load it. 52 | 53 | 54 | NOTE 55 | 56 | Thee appears to be a bug in the standard c compiler's optimizer in 57 | 4.1.3. I have added a workaround for one problem this bug causes, but 58 | there may be others. It may be necessary on this OS version at least 59 | to turn off optimization or to use gcc. 60 | 61 | -------------------------------------------------------------------------------- /src/c/machines/vax/README: -------------------------------------------------------------------------------- 1 | I no longer have access to a VAX, but I believe the following will 2 | work under Ultrix or BSD, assuming X11 stuff is in a standard place: 3 | 4 | GRAPHSYS = X11WINDOWS 5 | X11INCDIR_FLAG= 6 | X11LIBDIR_FLAG= 7 | 8 | UCFLAGS = -O 9 | ULDFLAGS = 10 | 11 | EXTRALIBS= 12 | EXTRAOBJS= 13 | 14 | IEEE_FLAG= 15 | ANSI_FLAG= 16 | 17 | FOREIGN_FLAG = -DFOREIGNCALL 18 | FOREIGN_FILE = bsd-foreign.h 19 | 20 | CC = cc 21 | LDCC = $(CC) 22 | 23 | The configure script should set up the Makefile to use these options. 24 | -------------------------------------------------------------------------------- /src/c/macintosh/CWHeader.h: -------------------------------------------------------------------------------- 1 | #define MACINTOSH 2 | #ifdef powerc 3 | # include 4 | #else 5 | # include 6 | #endif 7 | #include 8 | #include 9 | -------------------------------------------------------------------------------- /src/c/macintosh/MakeXLSDistribution: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jhbadger/xlispstat/f1bea6053df658ee48612bf1f63c35de99e2c649/src/c/macintosh/MakeXLSDistribution -------------------------------------------------------------------------------- /src/c/macintosh/README: -------------------------------------------------------------------------------- 1 | This directory contains Lisp and C files for compiling and running 2 | XLISP-STAT on the Macintosh with Metrowerks CodeWarrior. 3 | 4 | The 68K Metrowerks project uses 68020/68881 code generation. To 5 | compile for 68K without 881 code generation, set the appropriate flags 6 | in the Preferences dialogs. 7 | -------------------------------------------------------------------------------- /src/c/macintosh/README.mac: -------------------------------------------------------------------------------- 1 | This the Macintosh distribution of XLISP-STAT Release 3. This 2 | distribution is available for anonymous ftp from ftp.stat.umn.edu in 3 | directory pub/xlispstat/. 4 | 5 | You need to obtain two self extracting archive files: the appropriate 6 | application for your system and the support files. The support files 7 | are in xlispstat-3-??-??-files.sea.hqx, where ?? corresponds to the 8 | current minor and subminor release numbers, and the applications are 9 | 10 | 'XLISP-STAT 3.??.?? PPC' in xlispstat-3-??-??-ppcapp.sea.hqx 11 | 'XLISP-STAT 3.??.?? 881' in xlispstat-3-??-??-881app.sea.hqx 12 | 'XLISP-STAT 3.??.?? 020' in xlispstat-3-??-??-020app.sea.hqx 13 | 'XLISP-STAT 3.??.?? GEN' in xlispstat-3-??-??-genapp.sea.hqx 14 | 15 | The GEN application should run on any 68K mac. The 020 application 16 | requires at least a 68020 processor but no coprocessor. The 881 17 | application requires both a 68020 or higher processor and a 18 | coprocessor. The PPC application is a PowerPC native code 19 | implementation. All versions have been compiled with MetroWerks 20 | CodeWarrior C. Extracting the support files creates a folder. After 21 | extracting your executable, place it in this folder. 22 | 23 | Some information on the changes since Release 2 is given in the file 24 | pub/xlispstat/doc/changes.ps. 25 | 26 | You may need to adjust your partition size if you have a large color 27 | screen or are using more than 256 colors. 28 | 29 | A minimal runtime system needs the application and the initial 30 | workspace, 'xlisp.wks', and any of the files in the Autoload folder 31 | you want to use. The application, initial workspace, and Autoload 32 | folder must be placed in the same folder. You can add the 'xlisp.hlp' 33 | file if you want documentation to be available. 34 | 35 | If you want to include any of the 'Autoload' files in the startup 36 | workspace, load them into a running application and do 37 | 38 | (save-workspace "newxlisp.wks") 39 | 40 | This creates a new workspace file and exits. You can then double click 41 | on this workspace, or you can rename it 'xlisp.wks' to make it the 42 | default startup workspace (keep a copy of the original one). To load 43 | the compiler, load the file 'cmpload.fsl' in the 'Autoload' folder. 44 | 45 | The lisp sources can be compiled by loading the 'cmpsys.lsp' file in 46 | the 'Lisp Sources' folder. This will recompile any .lsp file whose 47 | corresponding .fsl file does not esist or has an earlier modification 48 | date. 49 | 50 | The file xlsx.h is a header file for use with external functions. 51 | 52 | Luke Tierney 53 | School of Statistics 54 | University of Minnesota 55 | Minneapolis, MN 55455 56 | luke@stat.umn.edu 57 | -------------------------------------------------------------------------------- /src/c/macintosh/TransEdit1.h: -------------------------------------------------------------------------------- 1 | /* 2 | TransEdit1.h - TransEdit header file -- modified for Xlisp-Stat, L. Tierney 3 | */ 4 | 5 | #ifndef __TRANSEDIT_H__ 6 | #define __TRANSEDIT_H__ 7 | 8 | #include "TransSkel1.h" 9 | 10 | #ifdef applec 11 | # include /* includes WindowMgr.h, QuickDraw.h, MacTypes.h */ 12 | # include 13 | # include 14 | # include 15 | #endif /* applec */ 16 | 17 | typedef pascal void (*TEditKeyProcPtr) (void); 18 | typedef pascal void (*TEditActivateProcPtr) (Boolean); 19 | typedef pascal void (*TEditCloseProcPtr) (void); 20 | 21 | /**** XLISP-STAT addition -- L. Tierney */ 22 | typedef pascal void (*TEditIdleProcPtr) (void); 23 | 24 | pascal WindowPtr NewEWindow (Rect *bounds, StringPtr title, Boolean visible, 25 | WindowPtr behind, Boolean goAway, 26 | long refNum, Boolean bindToFile); 27 | 28 | pascal WindowPtr GetNewEWindow (short resourceNum, WindowPtr behind, Boolean bindToFile); 29 | pascal TEHandle GetEWindowTE (WindowPtr wind); 30 | pascal Boolean GetEWindowFile (WindowPtr wind, SFReply *fileInfo); 31 | pascal Boolean IsEWindow (WindowPtr wind); 32 | pascal Boolean IsEWindowDirty (WindowPtr wind); 33 | 34 | pascal void SetEWindowProcs (WindowPtr wind, TEditKeyProcPtr pKey, 35 | TEditActivateProcPtr pActivate, TEditCloseProcPtr pClose, 36 | TEditIdleProcPtr pIdle); 37 | pascal void SetEWindowStyle (WindowPtr wind, short font, 38 | short size, Style style, short wrap, short just); 39 | /* added style parameter - L. Tierney */ 40 | pascal void EWindowOverhaul (WindowPtr wind, Boolean showCaret, 41 | Boolean recalc, Boolean dirty); 42 | 43 | pascal void SetEWindowCreator (OSType creat); 44 | pascal Boolean EWindowSave (WindowPtr wind); 45 | pascal Boolean EWindowSaveAs (WindowPtr wind); 46 | pascal Boolean EWindowSaveCopy (WindowPtr wind); 47 | pascal Boolean EWindowClose (WindowPtr wind); 48 | pascal Boolean EWindowRevert (WindowPtr wind); 49 | pascal Boolean ClobberEWindows (void); 50 | pascal void EWindowEditOp (short item); 51 | 52 | /**** XLISP-STAT additions -- L. Tierney */ 53 | pascal void SetEWindowDirty (WindowPtr theWind, Boolean ndirty); 54 | pascal void EWindowAdjustDisplay (WindowPtr theWind); 55 | 56 | /* from FakeAlert.h */ 57 | 58 | pascal short FakeAlert (StringPtr s1, StringPtr s2, StringPtr s3, StringPtr s4, 59 | short nButtons, short defButton, short cancelButton, 60 | StringPtr t1, StringPtr t2, StringPtr t3); 61 | 62 | #endif /* __TRANSEDIT_H__ */ 63 | -------------------------------------------------------------------------------- /src/c/macintosh/dirent.c: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/jhbadger/xlispstat/f1bea6053df658ee48612bf1f63c35de99e2c649/src/c/macintosh/dirent.c -------------------------------------------------------------------------------- /src/c/macintosh/dlfcn.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | 6 | #include 7 | #include "macutils.h" 8 | 9 | static char errbuf[512]; 10 | 11 | /* Minimal emulation of SysVR4-ELF dynamic loading routines for the Macintosh. 12 | * Based on code by Bob Stine as Modified by Steve Majewski. */ 13 | void *dlopen(const char *name, int mode) 14 | { 15 | FSSpec fileSpec; 16 | Str255 errName, libName; 17 | OSErr err; 18 | Ptr mainAddr; 19 | CFragConnectionID connID; 20 | 21 | /* Build a file spec record for GetDiskFragment */ 22 | if (strlen(name) < 254) 23 | strcpy((char *) libName, name); 24 | else { 25 | sprintf(errbuf, "library name too long"); 26 | return NULL; 27 | } 28 | CtoPstr((char *) libName); 29 | err = FSMakeFSSpecFromPath((ConstStr255Param) libName, &fileSpec); 30 | if (err != noErr) { 31 | sprintf(errbuf, "error code %d creating file spec for library %s", 32 | err, name); 33 | return NULL; 34 | } 35 | 36 | /* Open the fragment (will not add another copy if loaded, though gives 37 | new ID) */ 38 | err = GetDiskFragment(&fileSpec, 0, kCFragGoesToEOF, 0, kLoadCFrag, 39 | &connID, &mainAddr, errName); 40 | if (err == noErr) 41 | return (void *) connID; 42 | else { 43 | PtoCstr(errName); 44 | sprintf(errbuf, "error code %d getting disk fragment %s for library %s", 45 | err, errName, name); 46 | return NULL; 47 | } 48 | } 49 | 50 | /* This version does not handle NULL as the library for looking in the 51 | executable. It also does not check the symbol class. */ 52 | void *dlsym(void *lib, const char *name) 53 | { 54 | CFragConnectionID connID = (CFragConnectionID) lib; 55 | OSErr err; 56 | Ptr symAddr; 57 | CFragSymbolClass symClass; 58 | Str255 symName; 59 | 60 | if (strlen(name) < 254) 61 | strcpy((char *) symName, name); 62 | else { 63 | sprintf(errbuf, "symbol name too long"); 64 | return NULL; 65 | } 66 | CtoPstr((char *) symName); 67 | err = FindSymbol(connID, symName, &symAddr, &symClass); 68 | if (err == noErr) 69 | return (void *) symAddr; 70 | else { 71 | sprintf(errbuf, "error code %d looking up symbol %s", err, name); 72 | return NULL; 73 | } 74 | } 75 | 76 | int dlclose(void *lib) 77 | { 78 | CFragConnectionID connID = (CFragConnectionID) lib; 79 | OSErr err; 80 | err = CloseConnection(&connID); 81 | if (err == noErr) 82 | return 0; 83 | else { 84 | sprintf(errbuf, "error code %d closing library", err); 85 | return -1; 86 | } 87 | } 88 | 89 | char *dlerror() 90 | { 91 | return errbuf; 92 | } 93 | -------------------------------------------------------------------------------- /src/c/macintosh/dlfcn.h: -------------------------------------------------------------------------------- 1 | #define RTLD_LAZY 1 2 | #define RTLD_NOW 2 3 | 4 | void *dlopen(const char *, int); 5 | void *dlsym(void *, const char *); 6 | int dlclose(void *); 7 | char *dlerror(void); 8 | -------------------------------------------------------------------------------- /src/c/macintosh/macutils.h: -------------------------------------------------------------------------------- 1 | OSErr GetDirectoryID(short vRefNum, long, StringPtr, long *, Boolean *); 2 | OSErr FSpGetDirectoryID(const FSSpec *, long *, Boolean *); 3 | OSErr FSMakeFSSpecFromPath(ConstStr255Param, FSSpecPtr); 4 | -------------------------------------------------------------------------------- /src/c/macintosh/macxsgraph.c: -------------------------------------------------------------------------------- 1 | /* macxsgraph - Macintosh lisp low level graphics functions */ 2 | /* XLISP-STAT 2.1 Copyright (c) 1990, by Luke Tierney */ 3 | /* Additions to Xlisp 2.1, Copyright (c) 1989 by David Michael Betz */ 4 | /* You may give out copies of this software; for conditions see the */ 5 | /* file COPYING included with this distribution. */ 6 | 7 | #include "xlisp.h" 8 | #include "xlstat.h" 9 | #include "xlgraph.h" 10 | 11 | #define MULTIPLIER 65535 12 | 13 | /* external variables */ 14 | extern LVAL k_initial; 15 | 16 | static RGBColor ListToRGB(LVAL x) 17 | { 18 | RGBColor color; 19 | 20 | if (! consp(x) || llength(x) != 3) xlerror("not a color list", x); 21 | color.red = MULTIPLIER * makefloat(car(x)); x = cdr(x); 22 | color.green = MULTIPLIER * makefloat(car(x)); x = cdr(x); 23 | color.blue = MULTIPLIER * makefloat(car(x)); 24 | return(color); 25 | } 26 | 27 | static LVAL RGBToList(RGBColor color) 28 | { 29 | LVAL result, rp; 30 | 31 | xlsave1(result); 32 | result = rp = mklist(3, NIL); 33 | rplaca(rp, cvflonum((FLOTYPE) (((double) color.red) / MULTIPLIER))); 34 | rp = cdr(rp); 35 | rplaca(rp, cvflonum((FLOTYPE) (((double) color.green) / MULTIPLIER))); 36 | rp = cdr(rp); 37 | rplaca(rp, cvflonum((FLOTYPE) (((double) color.blue) / MULTIPLIER))); 38 | xlpop(); 39 | return(result); 40 | } 41 | 42 | LVAL xspick_color(void) 43 | { 44 | Point where; 45 | char *prompt; 46 | RGBColor in_color, out_color; 47 | int ok; 48 | LVAL arg; 49 | Str255 pbuf; 50 | 51 | if (! StScreenHasColor()) return(NIL); 52 | 53 | in_color.red = 0; 54 | in_color.green = 0; 55 | in_color.blue = 0; 56 | if (moreargs()) { 57 | prompt = (char *) getstring(xlgastring()); 58 | if (xlgetkeyarg(k_initial, &arg)) in_color = ListToRGB(arg); 59 | } 60 | else prompt = "Pick a color"; 61 | 62 | where.h = 0; where.v = 0; 63 | CintoPstring(prompt, pbuf, sizeof pbuf, FALSE); 64 | NotifyIfInBackground(); 65 | ok = GetColor(where, pbuf, &in_color, &out_color); 66 | 67 | return((ok) ? RGBToList(out_color) : NIL); 68 | } 69 | -------------------------------------------------------------------------------- /src/c/macintosh/sys_dirent.h: -------------------------------------------------------------------------------- 1 | /**************************************************************************************** 2 | * 3 | * File: sys_dirent.h 4 | * Created: 7/3/93 By: George T. Talbot 5 | * Purpose: Implements UNIX-like directory reading for the Macintosh. 6 | * Filesystem-independent directory information. 7 | * 8 | * Modifications: 9 | * 10 | * Notes: 11 | * 1) These routines will NOT work under A/UX. 12 | * 2) WD = working directory 13 | * 3) CD = change directory 14 | * 4) FS = file system 15 | * 5) Mac filesystems allow spaces as part of pathnames! 16 | * 6) All routines which return a path use the default Macintosh path separator, 17 | * a colon (":"). 18 | * 19 | ****************************************************************************************/ 20 | 21 | #ifndef __sys_dirent_h 22 | #define __sys_dirent_h 23 | 24 | #include 25 | 26 | struct dirent { 27 | /* PRIVATE FIELDS. Use fields after PUBLIC */ 28 | struct dirent **next; 29 | FSSpec fsp; 30 | 31 | /* PUBLIC. */ 32 | long d_off; /* index (to seekdir()) of this entry */ 33 | long d_fileno; /* File number (dirID) of this entry */ 34 | #define d_parent fsp.parID /* File number (dirID) of parent */ 35 | #define d_reclen sizeof(struct dirent) /* Size of this record */ 36 | #define d_namelen strlen(fsp.name) /* Length of the name */ 37 | #define d_name fsp.name /* Name */ 38 | #define d_volume fsp.vRefNum 39 | }; 40 | 41 | #define DIRSIZ(dp) sizeof(struct dirent) 42 | 43 | #endif /* !__sys_dirent_h */ 44 | -------------------------------------------------------------------------------- /src/c/macintosh/xlconfig.h: -------------------------------------------------------------------------------- 1 | #define ANSI 2 | #define IEEEFP 3 | #define ADEPTH 8000 4 | #define EDEPTH 8000 5 | #define IEEEFP 6 | #define STSZ 6 * 32768 7 | #ifdef powerc 8 | # define HAVE_DLOPEN 1 9 | # define SHAREDLIBS 10 | #else 11 | # define HAVE_DLOPEN 0 12 | #endif 13 | -------------------------------------------------------------------------------- /src/c/macintosh/xlsx.h: -------------------------------------------------------------------------------- 1 | /* xlsx.h - Include file for external Macintosh routines. */ 2 | /* XLISP-STAT 2.1 Copyright (c) 1990, by Luke Tierney */ 3 | /* Additions to Xlisp 2.1, Copyright (c) 1989 by David Michael Betz */ 4 | /* You may give out copies of this software; for conditions see the */ 5 | /* file COPYING included with this distribution. */ 6 | 7 | /* Calling conventions are based on the conventions given in the New S */ 8 | /* book. */ 9 | typedef struct { 10 | int argc; 11 | char **argv; 12 | } XLSXblock; 13 | 14 | #define XLSXargc(p) ((p)->argc) 15 | #define XLSXargv(p, i) ((p)->argv[(i)]) 16 | -------------------------------------------------------------------------------- /src/c/makerot.c: -------------------------------------------------------------------------------- 1 | /* makerotation - Construct rotation from x to y by alpha. */ 2 | /* XLISP-STAT 2.1 Copyright (c) 1990, by Luke Tierney */ 3 | /* Additions to Xlisp 2.1, Copyright (c) 1989 by David Michael Betz */ 4 | /* You may give out copies of this software; for conditions see the */ 5 | /* file COPYING included with this distribution. */ 6 | 7 | #include "linalg.h" 8 | 9 | VOID make_rotation P6C(int, n, 10 | double *, rot, 11 | double *, x, 12 | double *, y, 13 | int, use_alpha, 14 | double, alpha) 15 | { 16 | double nx, ny, xy, c, s, cc, cm1, a, b; 17 | int i, j, in; 18 | 19 | for (i = 0, in = 0; i < n; i++, in += n) { 20 | for (j = 0; j < n; j++) 21 | rot[in + j] = 0.0; 22 | rot[in + i] = 1.0; 23 | } 24 | 25 | nx = blas_dnrm2(n, x, 1); 26 | ny = blas_dnrm2(n, y, 1); 27 | if (nx == 0.0 || ny == 0.0) return; 28 | 29 | blas_dscal(n, 1.0 / nx, x, 1); 30 | blas_dscal(n, 1.0 / ny, y, 1); 31 | 32 | xy = blas_ddot(n, x, 1, y, 1); 33 | 34 | c = (use_alpha) ? cos(alpha) : xy; 35 | cc = 1 - c * c; 36 | s = (use_alpha) ? sin(alpha) : sqrt(cc > 0 ? cc : 0.0); 37 | cm1 = c - 1.0; 38 | 39 | blas_daxpy(n, -xy, x, 1, y, 1); 40 | 41 | ny = blas_dnrm2(n, y, 1); 42 | if (ny == 0.0) 43 | return; 44 | blas_dscal(n, 1.0 / ny, y, 1); 45 | 46 | for (i = 0, in = 0; i < n; i++, in += n) { 47 | a = x[i] * cm1 + y[i] * s; 48 | b = - x[i] * s + y[i] * cm1; 49 | for (j = 0; j < n; j++) 50 | rot[in + j] = a * x[j] + b * y[j]; 51 | rot[in + i] += 1.0; 52 | } 53 | } 54 | 55 | -------------------------------------------------------------------------------- /src/c/mswin/README: -------------------------------------------------------------------------------- 1 | These sources need to be merged with the unix sources in th directory 2 | above. The result compiles with Borland C++ 4.0 and seems to work 3 | Because of the small system stack the byte code compiler cannot be 4 | compiled from scratch under MS Windows, but it can be compiled by 5 | starting with .fsl files created elsewhere. 6 | 7 | -------------------------------------------------------------------------------- /src/c/mswin/cursors/brush.uu: -------------------------------------------------------------------------------- 1 | begin 644 BRUSH.CUR 2 | M " $ (" " !0 !@ P 0 %@ "@ @ 0 $ 0 $ 3 | M ____ 4 | M !@ 8 !@ 8 & !@ 8 & 5 | M/_P #_\ /_P #_\ 55 %50 %54 "JJ 6 | M _____________________________G____P_ 7 | M___\/____#____P____\/____#____P____\/____#___X !__^ ?__@ '_ 8 | M_X !__^ ?__@ '__X !__^ ?__ '__@ #__X !___________________ 9 | +________________ 10 | 11 | end 12 | -------------------------------------------------------------------------------- /src/c/mswin/cursors/finger.uu: -------------------------------------------------------------------------------- 1 | begin 644 FINGER.CUR 2 | M " $ (" " H ! P 0 %@ "@ @ 0 $ 0 $ 3 | M ____ 4 | M /P #\ !_@ 5 | M_X /^ #_@ JH *J "J@ *@ " @ ( " 6 | M ____________________________________ 7 | M_____________________________X#___^ ?___@'___P ___X /__^ #__ 8 | M_@ ___X /__^ #___@ ___\ /___@/___X____^/____C____]__________ 9 | +________________ 10 | 11 | end 12 | -------------------------------------------------------------------------------- /src/c/mswin/cursors/gc.uu: -------------------------------------------------------------------------------- 1 | begin 644 GC.CUR 2 | M " $ (" " ! #P P 0 %@ "@ @ 0 $ 0 $ 3 | M ____ 4 | M 'X /_@ __\ /__@ '__\ !\Z[X 'LO^ # 5 | M[[_@ ^Z[X 'QQ\ !___ '__@ __ #_ ?@ ! $ # 6 | M@ !@ ____________________________________ 7 | M___\ ___X #__@ ?_X #_\ ?_ '_P _\ /^ #_@ _X / 8 | M^ #_P !_\ ?_P /_^ ?__X ?___ /___\?___^#____ ?___P'___ 9 | +\/____________\? 10 | 11 | end 12 | -------------------------------------------------------------------------------- /src/c/mswin/cursors/hand.uu: -------------------------------------------------------------------------------- 1 | begin 644 HAND.CUR 2 | M " $ (" " P P P 0 %@ "@ @ 0 $ 0 $ 3 | M ____ 4 | M /P #\ !_@ 5 | M_X /^ #_@ JH *J "J@ *H "J J@ *@ "H ( 6 | M ____________________________________ 7 | M_____________________________X#___^ ?___@'___P ___X /__^ #__ 8 | M_@ ___X /__^ #___@ ___\ /___@#___X ___^ ?___@/___\'____W____ 9 | +________________ 10 | 11 | end 12 | -------------------------------------------------------------------------------- /src/c/mswin/dlfcn.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | 5 | static char errbuf[512]; 6 | 7 | void *dlopen(const char *name, int mode) 8 | { 9 | HINSTANCE hdll; 10 | 11 | hdll = LoadLibrary(name); 12 | #ifdef _WIN32 13 | if (! hdll) { 14 | sprintf(errbuf, "error code %d loading library %s", GetLastError(), name); 15 | return NULL; 16 | } 17 | #else 18 | if ((UINT) hdll < 32) { 19 | sprintf(errbuf, "error code %d loading library %s", (UINT) hdll, name); 20 | return NULL; 21 | } 22 | #endif 23 | return (void *) hdll; 24 | } 25 | 26 | void *dlsym(void *lib, const char *name) 27 | { 28 | HMODULE hdll = (HMODULE) lib; 29 | void *symAddr; 30 | symAddr = (void *) GetProcAddress(hdll, name); 31 | if (symAddr == NULL) 32 | sprintf(errbuf, "can't find symbol %s", name); 33 | return symAddr; 34 | } 35 | 36 | int dlclose(void *lib) 37 | { 38 | HMODULE hdll = (HMODULE) lib; 39 | 40 | #ifdef _WIN32 41 | if (FreeLibrary(hdll)) 42 | return 0; 43 | else { 44 | sprintf(errbuf, "error code %d closing library", GetLastError()); 45 | return -1; 46 | } 47 | #else 48 | FreeLibrary(hdll); 49 | return 0; 50 | #endif 51 | } 52 | 53 | char *dlerror() 54 | { 55 | return errbuf; 56 | } 57 | -------------------------------------------------------------------------------- /src/c/mswin/dlfcn.h: -------------------------------------------------------------------------------- 1 | #define RTLD_LAZY 0 2 | #define RTLD_NOW 1 3 | 4 | void *dlopen(const char *, int); 5 | void *dlsym(void *, const char *); 6 | int dlclose(void *); 7 | char *dlerror(void); 8 | 9 | -------------------------------------------------------------------------------- /src/c/mswin/dllstub.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | int APIENTRY DllMain(HANDLE hdll, DWORD reason, LPVOID reserved ) 4 | { 5 | switch( reason ) { 6 | case DLL_THREAD_ATTACH: break; 7 | case DLL_THREAD_DETACH: break; 8 | case DLL_PROCESS_ATTACH: break; 9 | case DLL_PROCESS_DETACH: break; 10 | } 11 | return( 1 ); 12 | } 13 | -------------------------------------------------------------------------------- /src/c/mswin/icons/graph.uu: -------------------------------------------------------------------------------- 1 | begin 644 GRAPH.ICO 2 | M ! $ (" 0 #H @ %@ "@ @ 0 $ ! @ ( 3 | M " " @( @ ( @ " @ 4 | M@(" ,# P /\ /\ #__P#_ _P#_ /__ #___\ 5 | M /______ 6 | M____________ #__________________P \ /\ /#_ 7 | M________________ #P_________________P \/________________\ 8 | M /#_________________ #P_________________P \/#_____________ 9 | M__\ /#_#P______________ #P__ /_____________P \/__\/_P____ 10 | M______\ /#___\/____________ #P__\/\ ___________P \/____#P 11 | M__\/______\ /#______P__________ #P____#__P#________P \/__ 12 | M_____P#_______\ /#_________#_#_____ #P__________ /_____P 13 | M\/______\/__\/____\ /#___________\/____ #P___________P\ __ 14 | M_P \/________________\ /#_________________ #P____________ 15 | M_____P __________________\ 16 | M #__________X & !@ 8 & !@ 8 & 17 | M !@ 8 & !@ 8 & !@ 8 & !@ 8 18 | M & !@ 8 & !@ 8 & !@ 8 & !____ 19 | !_P& 20 | 21 | end 22 | -------------------------------------------------------------------------------- /src/c/mswin/icons/ledit.uu: -------------------------------------------------------------------------------- 1 | begin 644 LEDIT.ICO 2 | M ! $ (" 0 #H @ %@ "@ @ 0 $ ! @ ( 3 | M " " @( @ ( @ " @ 4 | M@(" ,# P /\ /\ #__P#_ _P#_ /__ #___\ 5 | M 6 | M ____________\ / __ #_ 7 | M___________P ____________\ / __ 8 | M #____________P ____________\ / __ 9 | M #____________P ____________\ / / 10 | M__ #____________P ____________\ / 11 | M #___ #____________P ____________\ / 12 | M /__ #____________P ____________\ 13 | M / #___ #____________P ____________\ 14 | M / /_P #___________ __________\ 15 | M 16 | M #________________@ #_X _^ /_@ #_X _^ /_@ 17 | M #_X _^ /_@ #_X _^ /_@ #_X _^ /_@ #_X _^ 18 | M /_@ #_X _^ /_@ #_X _^ ?_@ /_X '_^ #___________ 19 | !___@ 20 | 21 | end 22 | -------------------------------------------------------------------------------- /src/c/mswin/icons/wxls.uu: -------------------------------------------------------------------------------- 1 | begin 644 WXLS.ICO 2 | M ! $ (" 0 #H @ %@ "@ @ 0 $ ! @ ( 3 | M " " @( @ ( @ " @ 4 | M@(" ,# P /\ /\ #__P#_ _P#_ /__ #___\ 5 | M ____________________ / #P______ 6 | M____________\ \/_P__G___ ________ /#__P#__Y_P$/_______P#P__ 7 | M^?#___\ #_______\ \/____#___ 0________ /#_____ /^0$/_______P 8 | M#P______\ \!#_______\ \/__G___D 0_Z______ /#____Y___P$/____ 9 | M___P#P________\!#____Z__\ \/__^?_P #Z____ /#_____\!$1$1 10 | M$0_____P#P______ 1$1$1$/K___\ \/_____P /___/ /#______/ 11 | MS\_/S\\/S__P#P______S\_/S\_/\ _\\ \/_____\_/S\_/S__ __ /#___ 12 | M__S\_/S\_/_/_P_P#P_____,S,S,S,_____P \/_____________\_/__ / 13 | M#_\/__\ #_\ /#____P#P_P_P__\/__#___#___\ \/#_\/__#___#___#_ 14 | M__ /#P\ _P____#__P___P#P\/_P__\/____#_\/__\ \/\/\/_P#__P_P 15 | M_P____ /#_\/___P___P#_#____P#___________________\ 16 | M 17 | M 18 | M 19 | ! 20 | 21 | end 22 | -------------------------------------------------------------------------------- /src/c/mswin/ledit.h: -------------------------------------------------------------------------------- 1 | /* Lisp Editor and Listener Window Class */ 2 | 3 | void InitLEditClass(void (*) (), HFONT); 4 | HWND CreateLEditWindow(HWND, HMENU, HANDLE); 5 | BOOL TTYHasInput(void); 6 | void TTYPutStr(char *); 7 | int TTYPutC(int); 8 | void TTYResetInput(void); 9 | void TTYFlushOutput(void); 10 | void TTYFlush(void); 11 | int TTYGetC(void); 12 | BOOL TTYHasSelection(void); 13 | void TTYSelToClip(void); 14 | void TTYClearSel(void); 15 | void TTYPasteFromClip(void); 16 | #ifdef NOTTY 17 | char *TTYSelectionStr(void); 18 | #else 19 | void TTYTrimBuffer(void); 20 | #endif /* NOTTY */ 21 | 22 | #define XLSGetWindowProc(w) ((WNDPROC) GetWindowLong(w, GWL_WNDPROC)) 23 | #define XLSEditCopy(w) SendMessage(w, WM_COPY, 0, 0) 24 | #define XLSEditClear(w) SendMessage(w, WM_CLEAR, 0, 0) 25 | #define XLSEditPaste(w) SendMessage(w, WM_PASTE, 0, 0) 26 | -------------------------------------------------------------------------------- /src/c/mswin/lspedit/README: -------------------------------------------------------------------------------- 1 | These files, together with ../ledit.[ch] and ../winutils.[ch] allow 2 | you to build lspedit. lspedit can be built as a 16 bit or a 32 bit 3 | application -- just comment out the appropriate definitions of BCC and 4 | BRS in the makefile. 5 | 6 | -------------------------------------------------------------------------------- /src/c/mswin/lspedit/lspedit.def: -------------------------------------------------------------------------------- 1 | ;module-definition file for Generic 2 | 3 | NAME LSPEDIT 4 | DESCRIPTION 'Sample Microsoft Windows Application' 5 | 6 | EXETYPE WINDOWS 7 | 8 | STUB 'WINSTUB.EXE' 9 | 10 | CODE MOVEABLE DISCARDABLE 11 | DATA MOVEABLE MULTIPLE 12 | 13 | HEAPSIZE 45055 14 | STACKSIZE 5120 15 | ;STACKSIZE 1048576 16 | 17 | EXPORTS 18 | MainWndProc @1 19 | About @22 20 | LEditWndProc @5 21 | -------------------------------------------------------------------------------- /src/c/mswin/lspedit/lspedit.h: -------------------------------------------------------------------------------- 1 | #define IDM_ABOUT 100 2 | 3 | #define IDM_NEW 101 4 | #define IDM_OPEN 102 5 | #define IDM_SAVE 103 6 | #define IDM_SAVEAS 104 7 | #define IDM_PRINT 105 8 | #define IDM_EXIT 106 9 | 10 | #define IDM_UNDO 200 11 | #define IDM_CUT 201 12 | #define IDM_COPY 202 13 | #define IDM_PASTE 203 14 | #define IDM_CLEAR 204 15 | #define IDM_EVAL 205 16 | 17 | #define IDC_EDIT 300 18 | 19 | #define IDC_FILENAME 400 20 | #define IDC_EDITNAME 401 21 | #define IDC_FILES 402 22 | #define IDC_PATH 403 23 | #define IDC_LISTBOX 404 24 | 25 | #define MAXFILESIZE 31000 /**** about max a win16 edit control can handle */ 26 | 27 | #ifndef RC_INVOKED 28 | int WINAPI WinMain(HINSTANCE, HINSTANCE, LPSTR, int); 29 | LONG CALLBACK MainWndProc(HWND, UINT, WPARAM, LONG); 30 | BOOL CALLBACK About(HWND, UINT, WPARAM, LONG); 31 | #endif 32 | -------------------------------------------------------------------------------- /src/c/mswin/lspedit/lspedit.rc: -------------------------------------------------------------------------------- 1 | #include "windows.h" 2 | #include "lspedit.h" 3 | 4 | #ifdef MinGW32 5 | LEditIcon ICON LEDIT.ICO 6 | #else 7 | LEditIcon ICON ..\icons\LEDIT.ICO 8 | #endif 9 | 10 | LSPEditMenu MENU 11 | BEGIN 12 | POPUP "&File" 13 | BEGIN 14 | MENUITEM "&New", IDM_NEW 15 | MENUITEM "&Open...", IDM_OPEN 16 | MENUITEM "&Save", IDM_SAVE 17 | MENUITEM "Save &As...", IDM_SAVEAS 18 | MENUITEM "&Print", IDM_PRINT, GRAYED 19 | MENUITEM SEPARATOR 20 | MENUITEM "E&xit", IDM_EXIT 21 | MENUITEM "About LSPEdit...", IDM_ABOUT 22 | END 23 | POPUP "&Edit" 24 | BEGIN 25 | MENUITEM "&Undo\tCtrl+Z", IDM_UNDO, GRAYED 26 | MENUITEM SEPARATOR 27 | MENUITEM "Cu&t\tCtrl+X", IDM_CUT 28 | MENUITEM "&Copy\tCtrl+C", IDM_COPY 29 | MENUITEM "&Paste\tCtrl+V", IDM_PASTE 30 | MENUITEM "C&lear\tDel", IDM_CLEAR 31 | MENUITEM SEPARATOR 32 | MENUITEM "Eval Selection", IDM_EVAL 33 | END 34 | END 35 | 36 | LSPEdit ACCELERATORS 37 | BEGIN 38 | VK_Z, IDM_UNDO, VIRTKEY, CONTROL 39 | VK_X, IDM_CUT, VIRTKEY, CONTROL 40 | VK_C, IDM_COPY, VIRTKEY, CONTROL 41 | VK_V, IDM_PASTE, VIRTKEY, CONTROL 42 | VK_DELETE, IDM_CLEAR, VIRTKEY 43 | END 44 | 45 | AboutBox DIALOG 22, 17, 144, 75 46 | STYLE DS_MODALFRAME | WS_CAPTION | WS_SYSMENU 47 | CAPTION "About LSPEdit" 48 | BEGIN 49 | CTEXT "Simple Lisp File Editor", -1, 0, 10, 144, 8 50 | CTEXT "Microsoft Windows", -1, 0, 26, 144, 8 51 | CTEXT "Version 3.0", -1, 0, 34, 144, 8 52 | DEFPUSHBUTTON "OK", IDOK, 53, 59, 32, 14, WS_GROUP 53 | END 54 | 55 | #ifndef MinGW32 56 | Open DIALOG 10, 10, 148, 112 57 | STYLE DS_MODALFRAME | WS_CAPTION | WS_SYSMENU 58 | CAPTION "Open" 59 | BEGIN 60 | LTEXT "Open File &Name:", IDC_FILENAME, 4, 4, 60, 10 61 | EDITTEXT IDC_EDIT, 4, 16, 100, 12, ES_AUTOHSCROLL 62 | LTEXT "&Files in", IDC_FILES, 4, 40, 32, 10 63 | LISTBOX, IDC_LISTBOX, 4, 52, 70, 56, WS_TABSTOP | WS_VSCROLL 64 | LTEXT "", IDC_PATH, 40, 40, 100, 10 65 | DEFPUSHBUTTON "&Open", IDOK, 87, 60, 50, 14 66 | PUSHBUTTON "CANCEL", IDCANCEL, 87, 80, 50, 14 67 | END 68 | 69 | SaveAs DIALOG 10, 10, 180, 53 70 | STYLE DS_MODALFRAME | WS_CAPTION | WS_SYSMENU 71 | CAPTION "Save As" 72 | BEGIN 73 | LTEXT "Save As File &Name:", IDC_FILENAME, 4, 4, 72, 10 74 | LTEXT "", IDC_PATH, 84, 4, 92, 10 75 | EDITTEXT IDC_EDIT, 4, 16, 100, 12 76 | DEFPUSHBUTTON "Save", IDOK, 120, 16, 50, 14 77 | PUSHBUTTON "Cancel", IDCANCEL 120, 36, 50, 14 78 | END 79 | #endif 80 | -------------------------------------------------------------------------------- /src/c/mswin/lspedit/makefile: -------------------------------------------------------------------------------- 1 | BCDIR = \BC5 2 | BCLIBDIR = $(BCDIR)\LIB 3 | INCLUDES = $(BCDIR)\INCLUDE;.. 4 | DEFINES = STRICT;NOTTY; 5 | CFLAGS = -v -w -W -I$(INCLUDES) -D$(DEFINES) -H -H=lspedit.csm 6 | RFLAGS = -I$(INCLUDES) -D$(DEFINES) 7 | LDFLAGS32 = -L$(BCLIBDIR) -Tpe -aa -c -x $(BCLIBDIR)\c0w32.obj 8 | LDFLAGS16 = -L$(BCLIBDIR) -Twe -c -C -x $(BCLIBDIR)\c0wl.obj 9 | SYSLIBS32 = $(BCLIBDIR)\import32.lib $(BCLIBDIR)\cw32mt.lib 10 | SYSLIBS16 = $(BCLIBDIR)\import.lib $(BCLIBDIR)\mathwl.lib $(BCLIBDIR)\cwl.lib 11 | 12 | !if $d(WIN16) 13 | BCC = bcc -ml 14 | TLINK = tlink 15 | BRC = brc 16 | LDFLAGS = $(LDFLAGS16) 17 | SYSLIBS = $(SYSLIBS16) 18 | !else 19 | BCC = bcc32 20 | TLINK = tlink32 21 | BRC = brc32 22 | LDFLAGS = $(LDFLAGS32) 23 | SYSLIBS = $(SYSLIBS32) 24 | !endif 25 | 26 | OFILES=ledit.obj lspedit.obj winutils.obj 27 | 28 | lspedit.exe: $(OFILES) lspedit.def lspedit.res 29 | $(TLINK) @&&| 30 | $(LDFLAGS) $(OFILES) 31 | $<,$* 32 | $(SYSLIBS) 33 | lspedit.def 34 | lspedit.res 35 | | 36 | 37 | lspedit.obj: lspedit.h lspedit.c 38 | $(BCC) -c $(CFLAGS) lspedit.c 39 | 40 | ledit.obj: ..\ledit.h ..\winutils.h ..\ledit.c 41 | $(BCC) -c $(CFLAGS) ..\ledit.c 42 | 43 | winutils.obj: ..\winutils.h ..\winutils.c 44 | $(BCC) -c $(CFLAGS) ..\winutils.c 45 | 46 | lspedit.res: lspedit.rc 47 | $(BRC) -R $(RFLAGS) -FO$@ lspedit.rc 48 | 49 | clean: 50 | del *.obj 51 | del *.res 52 | 53 | veryclean: clean 54 | del *.exe 55 | del "*.#*" 56 | del *.csm 57 | -------------------------------------------------------------------------------- /src/c/mswin/lspedit/makefile.gnu: -------------------------------------------------------------------------------- 1 | CC=gcc 2 | 3 | OFILES=ledit.o lspedit.o winutils.o resources.o 4 | 5 | CFLAGS= -Wall -DNOTTY -DSTRICT -DMinGW32 -I.. -I. -g 6 | 7 | lspedit.exe: $(OFILES) lspedit.def 8 | $(CC) -g -mwindows -o junk -Wl,--base-file,my.base $(OFILES) 9 | dlltool --dllname $@ --base-file my.base --output-exp my.exp 10 | $(CC) -g -mwindows -o $@ $(OFILES) -Wl,my.exp 11 | strip $@ 12 | del my.exp 13 | del my.base 14 | del junk.exe 15 | 16 | ledit.o: ../ledit.c ../ledit.h ../winutils.h 17 | $(CC) $(CFLAGS) -c ../ledit.c 18 | 19 | lspedit.o: lspedit.h 20 | 21 | winutils.o: ../winutils.c ../winutils.h 22 | $(CC) $(CFLAGS) -c ../winutils.c 23 | 24 | resources.o: lspedit.rc ledit.ico 25 | windres -i lspedit.rc -o resources.o --define MinGW32 26 | 27 | ledit.ico: ../icons/ledit.ico 28 | copy ..\icons\ledit.ico ledit.ico 29 | 30 | clean: 31 | del *.o 32 | del ledit.ico 33 | -------------------------------------------------------------------------------- /src/c/mswin/makefile.gnu: -------------------------------------------------------------------------------- 1 | VPATH=.. 2 | 3 | CC=gcc 4 | 5 | CFLAGS = -Wall -DSTRICT -DMinGW32 -I. -I.. -g 6 | 7 | OFILES=xlisp.o xlarray.o xlbfun.o xlbignum.o xlcont.o xldbug.o xldmem.o \ 8 | xleval.o xlfio.o xlglob.o xlimage.o xlio.o xljump.o \ 9 | xllist.o xlmath3.o xlpp.o xlprin.o xlrand.o xlread.o xlseq.o \ 10 | xlstr.o xlstruct.o xlsubr.o xlsym.o xlsys.o xltvec.o \ 11 | xlbcode.o xlbcutil.o xlshlib.o dlfcn.o xlmodule.o dummycod.o \ 12 | xlwrap.o mswstuff.o statdum.o basics.o betab.o bivnor.o common.o \ 13 | compound.o ddists.o dists.o gamln.o gammab.o \ 14 | linalg.o ludecomp.o math.o mats1.o mats2.o nor.o \ 15 | objects.o ppnd.o sortdata.o eigen.o stats.o stmem.o studentb.o \ 16 | utils.o utils2.o minimize.o cholesky.o svdecomp.o qrdecomp.o \ 17 | makerot.o cfft.o lowess.o kernel.o splines.o blas.o \ 18 | obinit.o xlinit.o statinit.o xlftab.o 19 | 20 | WFILES=wxlisp.o ledit.o winutils.o mswdynld.o 21 | 22 | GRFILES=dialogs.o hrdwrobs.o iview.o iviewdat.o iviewint.o \ 23 | iviewscl.o menus.o windows.o xssctplt.o xssctmat.o \ 24 | xsnewplt.o xsnames.o xsivint.o xshist.o xsgraph.o xsiview.o \ 25 | xsiview2.o xsiview3.o xsspin.o xsivwin.o xsivwin2.o \ 26 | filedlgs.o mswdlg.o mswgraph.o mswmenus.o mswrszbr.o mswwins.o 27 | 28 | ALLOFILES = $(WFILES) $(OFILES) $(GRFILES) resources.o 29 | 30 | ../wxls32.exe: $(ALLOFILES) 31 | $(CC) -g -mwindows -o junk -Wl,--base-file,my.base $(ALLOFILES) 32 | dlltool --dllname $@ --base-file my.base --output-exp my.exp 33 | $(CC) -g -mwindows -o $@ $(ALLOFILES) -Wl,my.exp 34 | 35 | XLISP_INCLUDES = ..\xlisp.h ..\xldmem.h ..\xlftab.h ..\xlglob.h xlconfig.h 36 | 37 | wxlisp.o: $(XLISP_INCLUDES) wxlisp.h ledit.h winutils.h ..\version.h 38 | mswgraph.o: $(XLISP_INCLUDES) wxlisp.h 39 | ledit.o: $(XLISP_INCLUDES) ledit.h winutils.h 40 | winutils.o: $(XLISP_INCLUDES) winutils.h 41 | xlftab.o: $(XLISP_INCLUDES) ..\xlisp.h ..\osdefs.h ..\osptrs.h 42 | $(OFILES): $(XLISP_INCLUDES) ..\xlisp.h 43 | statinit.o xlimage.o mswstuff.o: $(XLISP_INCLUDES) ..\version.h 44 | 45 | resources.o: wxls32.rc 46 | windres -i wxls32.rc -o resources.o --define MinGW32 47 | -------------------------------------------------------------------------------- /src/c/mswin/mswmem.c: -------------------------------------------------------------------------------- 1 | #ifdef _Windows 2 | 3 | #include 4 | #include 5 | #include 6 | 7 | extern char *Lmalloc(unsigned long); 8 | extern char *Lrealloc(char *, unsigned long); 9 | extern void Lfree(char *); 10 | 11 | char *NewSegment() 12 | { 13 | HANDLE h; 14 | h = GlobalAlloc(GMEM_FIXED, 0x010000L); 15 | return ((h) ? GlobalLock(h) : 0); 16 | } 17 | 18 | void FreeSegment(char *s) 19 | { 20 | GlobalUnlockPtr(s); 21 | GlobalFree(GlobalPtrHandle(s)); 22 | } 23 | 24 | char *malloc(unsigned n) { return(Lmalloc(n)); } 25 | char *realloc(char *s, unsigned n) { return(Lrealloc(s, n)); } 26 | void free(char *s) { Lfree(s); } 27 | 28 | char *calloc(unsigned n, unsigned m) 29 | { 30 | char *s; 31 | long size; 32 | size = ((long) n) * ((long) m); 33 | s = Lmalloc(size); 34 | if (s) memset(s, 0, (size_t) size); 35 | return(s); 36 | } 37 | 38 | #else 39 | extern char *Lmalloc(), *Lrealloc(); 40 | extern void Lfree(); 41 | 42 | extern char *malloc(); 43 | 44 | char *NewSegment() { return(malloc(0x010000)); } 45 | void FreeSegment(s) char *s; { free(s); } 46 | 47 | main() 48 | { 49 | int i, n; 50 | char *s; 51 | 52 | n = 10000; 53 | s = Lmalloc(n); 54 | for (i = 0; i < n; i++) s[i] = 1; 55 | s = Lrealloc(s, 2 * n); 56 | for (i = 0; i < 2 * n; i++) s[i] = 1; 57 | s = Lrealloc(s, n); 58 | for (i = 0; i < n; i++) s[i] = 1; 59 | } 60 | #endif 61 | -------------------------------------------------------------------------------- /src/c/mswin/statdum.c: -------------------------------------------------------------------------------- 1 | #ifdef XLISP_ONLY 2 | long time_stamp; 3 | 4 | statfinit() { return(0); } 5 | statsymbols() { return(0); } 6 | set_function_docstring() { return(0); } 7 | #endif 8 | 9 | #define TRUE 1 10 | #define FALSE 0 11 | 12 | #ifdef NOGRAPHICS 13 | StHasWindows() { return(FALSE); } 14 | StScreenHasColor() { return(FALSE); } 15 | StInitGraphics() { return(0); } 16 | StGWGetCursRefCon() { return(0); } 17 | StGWSetCursRefCon() { return(0); } 18 | StGWSetColRefCon() { return(0); } 19 | StGWSetSymRefCon() { return(0); } 20 | #endif /* NOGRAPHICS */ 21 | 22 | -------------------------------------------------------------------------------- /src/c/mswin/winutils.h: -------------------------------------------------------------------------------- 1 | void Delay(unsigned); 2 | void SysBeep(int); 3 | void FlushAllEvents(void); 4 | int OKorCancelBox(char *); 5 | int WarningBox(char *); 6 | #ifdef WIN32 7 | int PrintDialog(HWND hWnd, PRINTDLG *pd, HANDLE hDevMode, HANDLE hDevNames); 8 | #endif 9 | 10 | #define HIBIT(x) ((x) & 0x8000) 11 | -------------------------------------------------------------------------------- /src/c/mswin/wxls.def: -------------------------------------------------------------------------------- 1 | NAME WXLISP 2 | 3 | DESCRIPTION 'XLISP-STAT' 4 | EXETYPE WINDOWS 5 | STUB 'WINSTUB.EXE' 6 | CODE PRELOAD MOVEABLE DISCARDABLE 7 | DATA PRELOAD MOVEABLE MULTIPLE 8 | HEAPSIZE 4096 9 | STACKSIZE 20000 10 | EXPORTS FRAMEWNDPROC 11 | CLOSEENUMPROC 12 | LISTENERWNDPROC 13 | LEDITWNDPROC 14 | DDEPROC 15 | XLSDLGPROC 16 | XLSMDIDLGPROC 17 | XLSMDLGPROC 18 | IVWINPROC 19 | RSZWINPROC 20 | -------------------------------------------------------------------------------- /src/c/mswin/wxls.rc: -------------------------------------------------------------------------------- 1 | #include 2 | #include "wxlisp.h" 3 | 4 | LEditIcon ICON icons/LEDIT.ICO 5 | GraphIcon ICON icons/GRAPH.ICO 6 | WXLSIcon ICON icons/WXLS.ICO 7 | 8 | GCCursor CURSOR cursors/GC.CUR 9 | HandCursor CURSOR cursors/HAND.CUR 10 | FingerCursor CURSOR cursors/FINGER.CUR 11 | BrushCursor CURSOR cursors/BRUSH.CUR 12 | 13 | MdiMenu MENU 14 | BEGIN 15 | #if defined(NOGRAPHICS) || defined(TESTING) 16 | POPUP "&File" 17 | BEGIN 18 | MENUITEM "New &Points", IDM_NEWPOINTS 19 | MENUITEM "New &Lines", IDM_NEWLINES 20 | MENUITEM SEPARATOR 21 | MENUITEM "E&xit", IDM_EXIT 22 | MENUITEM "About XLISP-STAT...", IDM_ABOUT 23 | END 24 | 25 | POPUP "&Edit" 26 | BEGIN 27 | MENUITEM "&Undo\tCtrl+Z", IDM_UNDO, GRAYED 28 | MENUITEM SEPARATOR 29 | MENUITEM "Cu&t\tCtrl+X", IDM_CUT 30 | MENUITEM "&Copy\tCtrl+C", IDM_COPY 31 | MENUITEM "&Paste\tCtrl+V", IDM_PASTE 32 | MENUITEM "C&lear\tDel", IDM_CLEAR 33 | MENUITEM SEPARATOR 34 | MENUITEM "Copy-Paste\tAlt+V", IDM_COPYPASTE 35 | END 36 | #endif 37 | POPUP "&Window" 38 | BEGIN 39 | MENUITEM "&Cascade\tShift+F5", IDM_CASCADE 40 | MENUITEM "&Tile\tShift+F4", IDM_TILE 41 | MENUITEM "Arrange &Icons", IDM_ARRANGE 42 | MENUITEM "Close &All", IDM_CLOSEALL 43 | END 44 | END 45 | 46 | MdiAccel ACCELERATORS 47 | BEGIN 48 | VK_Z, IDM_UNDO, VIRTKEY, CONTROL 49 | VK_X, IDM_CUT, VIRTKEY, CONTROL 50 | VK_C, IDM_COPY, VIRTKEY, CONTROL 51 | VK_V, IDM_PASTE, VIRTKEY, CONTROL 52 | VK_DELETE, IDM_CLEAR, VIRTKEY 53 | VK_V, IDM_COPYPASTE, VIRTKEY, ALT 54 | VK_CANCEL, IDM_TOPLEVEL, VIRTKEY, CONTROL 55 | VK_F5, IDM_CASCADE, VIRTKEY, SHIFT 56 | VK_F4, IDM_TILE, VIRTKEY, SHIFT 57 | END 58 | -------------------------------------------------------------------------------- /src/c/mswin/xlconfig.h: -------------------------------------------------------------------------------- 1 | #define ANSI 2 | #define EDEPTH 4000 3 | #define ADEPTH 5000 4 | #define IEEEFP 5 | #ifdef _WIN32 6 | # define HAVE_DLOPEN 1 7 | # define SHAREDLIBS 8 | # ifndef WIN32 9 | # define WIN32 10 | # endif 11 | # define STSZ win32stsz 12 | # define WIN32S_STSZ 70000 13 | #else 14 | # define HAVE_DLOPEN 0 15 | /* defines from sys\stat.h not included for Win16 for some reason */ 16 | # define S_ISDIR(m) ((m) & S_IFDIR) 17 | # define S_ISCHR(m) ((m) & S_IFCHR) 18 | # define S_ISBLK(m) ((m) & S_IFBLK) 19 | # define S_ISREG(m) ((m) & S_IFREG) 20 | # define S_ISFIFO(m) ((m) & S_IFIFO) 21 | # define STSZ 20000 22 | #endif 23 | 24 | #ifndef _Windows 25 | # define _Windows 26 | #endif 27 | -------------------------------------------------------------------------------- /src/c/mswin/xlsclient/makefile: -------------------------------------------------------------------------------- 1 | BCDIR = \BC5 2 | BCLIBDIR = $(BCDIR)\LIB 3 | INCLUDES = $(BCDIR)\INCLUDE;.. 4 | FLAGS = -I$(INCLUDES) -L$(BCLIBDIR) 5 | 6 | xlsclient.exe: xlsclient.c 7 | bcc32 $(FLAGS) xlsclient.c 8 | 9 | clean: 10 | del *.obj 11 | del *.res 12 | 13 | veryclean: clean 14 | del *.exe 15 | del "*.#*" 16 | del *.csm 17 | -------------------------------------------------------------------------------- /src/c/mswin/xlsclient/makefile.gnu: -------------------------------------------------------------------------------- 1 | xlsclient.exe: xlsclient.c 2 | gcc -o xlsclient.exe xlsclient.c 3 | -------------------------------------------------------------------------------- /src/c/mswin/xlsx.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | 4 | #ifdef WIN32 5 | BOOL WINAPI DllEntryPoint(HINSTANCE hInst, DWORD reason, LPVOID rsrvd) 6 | #pragma argsused 7 | { 8 | return TRUE; 9 | } 10 | #else 11 | int FAR PASCAL LibMain(HINSTANCE hInst, WORD wDS, WORD wHS, LPSTR lpszCmd) 12 | #pragma argsused wHS 13 | { 14 | if (wHS > 0) UnlockData(0); 15 | return(1); 16 | } 17 | 18 | int FAR PASCAL WEP(int nParam) 19 | #pragma argsused 20 | { 21 | return(1); 22 | } 23 | #endif 24 | 25 | -------------------------------------------------------------------------------- /src/c/mswin/xlsx.h: -------------------------------------------------------------------------------- 1 | /* xlsx.h - Include file for external Macintosh routines. */ 2 | /* XLISP-STAT 2.1 Copyright (c) 1990, by Luke Tierney */ 3 | /* Additions to Xlisp 2.1, Copyright (c) 1989 by David Michael Betz */ 4 | /* You may give out copies of this software; for conditions see the */ 5 | /* file COPYING included with this distribution. */ 6 | 7 | /* Calling conventions are based on the conventions given in the New S */ 8 | /* book. */ 9 | typedef struct { 10 | int argc; 11 | char **argv; 12 | } XLSXblock; 13 | 14 | #define XLSXargc(p) ((p)->argc) 15 | #define XLSXargv(p, i) ((p)->argv[(i)]) 16 | -------------------------------------------------------------------------------- /src/c/xlmodule.c: -------------------------------------------------------------------------------- 1 | #include "xlisp.h" 2 | #include "xlmodule.h" 3 | 4 | VOID init___dummy _((int *pn, VOID (***pf) _((int)))); 5 | 6 | MODULE xlmodules[1]; 7 | int xlnummodules = 1; 8 | int xlcurrentmodule = 0; 9 | 10 | VOID init_modules(V) 11 | { 12 | xlmodules[0].name = "dummy"; 13 | init___dummy(&xlmodules[0].numfunctions, &xlmodules[0].functions); 14 | } 15 | 16 | -------------------------------------------------------------------------------- /src/c/xssystem.c: -------------------------------------------------------------------------------- 1 | /* xssystem - calling UNIX utilities */ 2 | /* XLISP-STAT 2.1 Copyright (c) 1990, by Luke Tierney */ 3 | /* Additions to Xlisp 2.1, Copyright (c) 1989 by David Michael Betz */ 4 | /* You may give out copies of this software; for conditions see the */ 5 | /* file COPYING included with this distribution. */ 6 | 7 | #include "xlisp.h" 8 | 9 | extern LVAL s_true, s_stdout; 10 | 11 | LVAL xssystem() 12 | { 13 | char *cmd; 14 | int status; 15 | LVAL stream = NIL; 16 | FILE *p; 17 | int ch; 18 | 19 | cmd = (char *) getstring(xlgastring()); 20 | if (moreargs()) { 21 | stream = xlgetarg(); 22 | if (stream == s_true) 23 | stream = getvalue(s_stdout); 24 | else if (!streamp(stream) && !ustreamp(stream)) 25 | xlbadtype(stream); 26 | } 27 | 28 | if (stream == NIL) { 29 | status = system(cmd); 30 | if (status == 127) xlfail("shell could not execute command"); 31 | } 32 | else { 33 | if ((p = popen(cmd, "r")) == NULL) 34 | xlfail("could not execute command"); 35 | while ((ch = getc(p)) != EOF) xlputc(stream, ch); 36 | status = pclose(p); 37 | } 38 | return(cvfixnum((FIXTYPE) status)); 39 | } 40 | 41 | 42 | 43 | -------------------------------------------------------------------------------- /src/include/StX11options.h: -------------------------------------------------------------------------------- 1 | /* StX11options - X11 compile options */ 2 | /* XLISP-STAT 2.1 Copyright (c) 1990, by Luke Tierney */ 3 | /* Additions to Xlisp 2.1, Copyright (c) 1989 by David Michael Betz */ 4 | /* You may give out copies of this software; for conditions see the */ 5 | /* file COPYING included with this distribution. */ 6 | 7 | 8 | /* Default values for options settable by x11-options. Values should */ 9 | /* be TRUE or FALSE. */ 10 | 11 | #define USE_FAST_LINES_DEFAULT FALSE 12 | #define USE_FAST_SYMBOLS_DEFAULT TRUE 13 | #define MOTION_SYNC_DEFAULT TRUE 14 | #define DO_CLIPPING_DEFAULT TRUE 15 | #define USE_ICCCM_DEFAULT TRUE 16 | #define WAIT_FOR_MAP_DEFAULT TRUE 17 | 18 | 19 | /* If you get X errors when you quit from xlispstat on a color or */ 20 | /* greyscale workstation this might be due to a possible server bug */ 21 | /* related to freeing color resources. Defining the preprocessor */ 22 | /* variable SERVER_COLOR_FREE_PROBLEM may help. */ 23 | 24 | #define SERVER_COLOR_FREE_PROBLEM 25 | 26 | /* On Ultrix 4.0 there is a bug in the Xmfb server's handling of the */ 27 | /* XDrawPoints request used in drawing fast symbols. To enable a */ 28 | /* workaround define the preprocessor variable DRAWPOINTSBUG. */ 29 | 30 | /*#define DRAWPOINTSBUG*/ 31 | 32 | -------------------------------------------------------------------------------- /src/include/bsd-foreign.h: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | #define STDBSD 4 | #define INTERNAL_CNAME_PATTERN "_%s" 5 | #define INTERNAL_FNAME_PATTERN "_%s_" 6 | #define CLIBS "-lm -lc" 7 | #define FLIBS "-lm -lc -lF77 -lI77 -lU77" 8 | #define LDPATTERN "ld -d -N -x -A %s -T %x %s %s %s -o %s" 9 | #define TMPPATTERN "/tmp/xlispdyn%d" 10 | #define TMPNAMESIZE 32 11 | #define PAGE_SIZE 4096 12 | #define MIN_ALLOC 10000 + PAGE_SIZE 13 | #define VERBDFLT TRUE 14 | -------------------------------------------------------------------------------- /src/include/dld-foreign.h: -------------------------------------------------------------------------------- 1 | #define SHLIB_DYNLOAD /* not really */ 2 | 3 | #define INTERNAL_CNAME_PATTERN "%s" 4 | #define INTERNAL_FNAME_PATTERN "%s_" /**** check this */ 5 | #define VERBDFLT TRUE 6 | 7 | LOCAL VOID link_and_load _((char *fname, char *libs, int fort)); 8 | LOCAL char *get_caddress _((char *name)); 9 | 10 | /*#include */ 11 | /* I don't want to bother looking for this include file, so I'll just */ 12 | /* declare the routines I need */ 13 | extern int dld_init(), dld_link(); 14 | extern unsigned long dld_get_func(); 15 | 16 | /**** This code ought to cache the addresses found, but I won't bother 17 | until I revise the way dynamic loading works */ 18 | 19 | static int dld_initialized = FALSE; 20 | 21 | LOCAL VOID link_and_load(fname, libs, fort) 22 | char *fname, *libs; 23 | int fort; 24 | { 25 | if (! dld_initialized) { 26 | if (dld_init(progname)) 27 | xlfail("dld initialization failed"); 28 | dld_initialized = TRUE; 29 | } 30 | 31 | if (dld_link(fname)) { 32 | sprintf(buf, "can't open %s", fname); 33 | xlfail(buf); 34 | } 35 | } 36 | 37 | LOCAL char *get_caddress(name) 38 | char *name; 39 | { 40 | LVAL next; 41 | void *handle; 42 | char *f; 43 | 44 | if (dld_initialized) 45 | return((char *) dld_get_func(name)); 46 | else 47 | return(NULL); 48 | } 49 | -------------------------------------------------------------------------------- /src/include/dummy-foreign.h: -------------------------------------------------------------------------------- 1 | /* a dummy include file */ 2 | -------------------------------------------------------------------------------- /src/include/encore-foreign.h: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | #ifdef n_offset 4 | #undef n_offset 5 | #endif 6 | 7 | #include 8 | #include 9 | 10 | extern SYMENT *lookupsym(); 11 | extern char *ldgetname(); 12 | 13 | #define INTERNAL_CNAME_PATTERN "_%s" 14 | #define INTERNAL_FNAME_PATTERN "_%s_" 15 | #define HAS_OWN_DYNLOAD 16 | #define VERBDFLT TRUE 17 | #define COFF_FORMAT 18 | 19 | #define SYMVALUE(sym) ((char *) ((sym).n_value)) 20 | 21 | #define SYM_IS_GLOBAL_FUNCTION(ldptr,symbol) \ 22 | ((symbol).n_sclass == C_EXT && (symbol).n_scnum > 0) 23 | 24 | static char *libraries[] = { 25 | "/lib/libc.a", 26 | "/usr/lib/libm.a", 27 | "/usr/lib/libF77.a", 28 | "/usr/lib/libI77.a", 29 | "/usr/lib/libU77.a", 30 | NULL 31 | }; 32 | 33 | static link_and_load(fname, libs, fort) 34 | char *fname, *libs; 35 | int fort; 36 | { 37 | char *code_start; 38 | static int inited = FALSE; 39 | LDFILE *fp; 40 | SYMENT symbol, *sym; 41 | char *symname, *symaddr; 42 | int i; 43 | 44 | if (! inited && initsyms(progname) == 0) 45 | xlfail("couldn't initialize symbol table"); 46 | else inited = TRUE; 47 | 48 | /* load the code */ 49 | if (dynload(fname, &code_start, 0L, libraries) <= 0) xlfail("load failed"); 50 | 51 | /* Enter the symbols. */ 52 | /* Assumes the value of the syment returned by lookupsym gives the */ 53 | /* offset from code_start. */ 54 | if ((fp = ldopen(fname, NULL)) == NULL) 55 | xlfail("cannot open object file for symbol reading"); 56 | i = 0; 57 | while (ldtbread(fp, i, &symbol) == SUCCESS) { 58 | i++; 59 | if (SYM_IS_GLOBAL_FUNCTION(input, symbol)) { 60 | symname = ldgetname(fp, &symbol); 61 | sym = lookupsym(symname); 62 | if (sym != NULL) { 63 | symaddr = code_start + (long) SYMVALUE(*sym); 64 | enter_csymbol(symname, symaddr); 65 | } 66 | } 67 | } 68 | if (ldclose(fp) == FAILURE) xlfail("cannot close object file"); 69 | } 70 | 71 | #undef n_name 72 | #include 73 | -------------------------------------------------------------------------------- /src/include/epix-foreign.h: -------------------------------------------------------------------------------- 1 | #ifdef CLOSED 2 | #undef CLOSED 3 | #endif 4 | 5 | #include 6 | #include 7 | 8 | #define INTERNAL_CNAME_PATTERN "%s" 9 | #define INTERNAL_FNAME_PATTERN "%s_" 10 | #define COFF_FORMAT 11 | #define CLIBS "-lm -lc" 12 | #define FLIBS "-lm -lc -lF77 -lI77 -lU77" 13 | #define LDPATTERN "ld -d -N -x -A %s -G 0 -T %x %s %s %s -o %s" 14 | #define TMPPATTERN "/tmp/xlispdyn%d" 15 | #define TMPNAMESIZE 32 16 | #define PAGE_SIZE 4096 17 | #define MIN_ALLOC 10000 + PAGE_SIZE 18 | #define VERBDFLT TRUE 19 | 20 | #define SYMENT SYMR 21 | #define SYMVALUE(sym) ((char *) ((sym).value)) 22 | #define N_SECTIONS(ldptr) HEADER(ldptr).f_nscns 23 | #define SCN_ADDR(ldptr,section_header) (section_header).s_vaddr 24 | #define SCN_LENGTH(ldptr,section_header) (section_header).s_size 25 | #define SCN_FILE_LOC(ldptr,section_header) ((section_header).s_scnptr) 26 | #define SCN_IS_BSS(ldptr,section_header) \ 27 | (strcmp(section_header.s_name, ".bss") == 0 \ 28 | || strcmp(section_header.s_name, ".sbss") == 0) 29 | 30 | #define SYM_IS_GLOBAL_FUNCTION(ldptr,symbol) \ 31 | ((symbol).sc == scText && (symbol).st == stProc) 32 | 33 | extern char *ldgetname(); 34 | -------------------------------------------------------------------------------- /src/include/hpux-foreign.h: -------------------------------------------------------------------------------- 1 | #define SHLIB_DYNLOAD 2 | 3 | #define INTERNAL_CNAME_PATTERN "%s" 4 | #define INTERNAL_FNAME_PATTERN "%s" /**** check this */ 5 | #define VERBDFLT TRUE 6 | 7 | LOCAL VOID link_and_load _((char *fname, char *libs, int fort)); 8 | LOCAL char *get_caddress _((char *name)); 9 | 10 | #include 11 | 12 | /**** This code ought to cache the addresses found, but I won't bother 13 | until I revise the way dynamic loading works */ 14 | 15 | LOCAL VOID link_and_load(fname, libs, fort) 16 | char *fname, *libs; 17 | int fort; 18 | { 19 | shl_t handle; 20 | 21 | handle = shl_load(fname, BIND_DEFERRED, 0L); 22 | if (handle == NULL) { 23 | sprintf(buf, "can't open %s", fname); 24 | xlfail(buf); 25 | } 26 | } 27 | 28 | LOCAL char *get_caddress(name) 29 | char *name; 30 | { 31 | shl_t handle; 32 | char *f; 33 | 34 | handle = NULL; 35 | if (shl_findsym(&handle, name, TYPE_PROCEDURE, &f) != 0) { 36 | handle = PROG_HANDLE; 37 | if (shl_findsym(&handle, name, TYPE_PROCEDURE, &f) != 0) 38 | f = NULL; 39 | } 40 | return(f); 41 | } 42 | -------------------------------------------------------------------------------- /src/include/pmax-foreign.h: -------------------------------------------------------------------------------- 1 | #ifdef CLOSED 2 | #undef CLOSED 3 | #endif 4 | 5 | #include 6 | #include 7 | 8 | #define INTERNAL_CNAME_PATTERN "%s" 9 | #define INTERNAL_FNAME_PATTERN "%s_" 10 | #define COFF_FORMAT 11 | #define CLIBS "-lm -lc" 12 | #define FLIBS "-lm -lc -lF77 -lI77 -lU77" 13 | #define LDPATTERN "ld -d -N -x -A %s -G 0 -T %x %s %s %s -o %s" 14 | #define TMPPATTERN "/tmp/xlispdyn%d" 15 | #define TMPNAMESIZE 32 16 | #define PAGE_SIZE 4096 17 | #define MIN_ALLOC 10000 + PAGE_SIZE 18 | #define VERBDFLT TRUE 19 | 20 | #define SYMENT SYMR 21 | #define SYMVALUE(sym) ((char *) ((sym).value)) 22 | #define N_SECTIONS(ldptr) HEADER(ldptr).f_nscns 23 | #define SCN_ADDR(ldptr,section_header) (section_header).s_vaddr 24 | #define SCN_LENGTH(ldptr,section_header) (section_header).s_size 25 | #define SCN_FILE_LOC(ldptr,section_header) ((section_header).s_scnptr) 26 | #define SCN_IS_BSS(ldptr,section_header) \ 27 | (strcmp(section_header.s_name, ".bss") == 0 \ 28 | || strcmp(section_header.s_name, ".sbss") == 0) 29 | 30 | #define SYM_IS_GLOBAL_FUNCTION(ldptr,symbol) \ 31 | ((symbol).sc == scText && (symbol).st == stProc) 32 | 33 | #ifdef FREAD 34 | #undef FREAD 35 | #endif 36 | #define FREAD FREADM 37 | 38 | extern char *ldgetname(); 39 | 40 | #define MEMPROT 41 | -------------------------------------------------------------------------------- /src/include/sysvr4-foreign.h: -------------------------------------------------------------------------------- 1 | #define SHLIB_DYNLOAD 2 | 3 | #define INTERNAL_CNAME_PATTERN "%s" 4 | #define INTERNAL_FNAME_PATTERN "%s_" /**** check this */ 5 | #define VERBDFLT TRUE 6 | 7 | LOCAL VOID link_and_load _((char *fname, char *libs, int fort)); 8 | LOCAL char *get_caddress _((char *name)); 9 | 10 | #include 11 | 12 | /**** This code ought to cache the addresses found, but I won't bother 13 | until I revise the way dynamic loading works */ 14 | 15 | LOCAL VOID link_and_load(fname, libs, fort) 16 | char *fname, *libs; 17 | int fort; 18 | { 19 | static initialized = FALSE; 20 | void *handle; 21 | 22 | if (! initialized) { 23 | setvalue(s_cfun_table, NIL); 24 | initialized = TRUE; 25 | } 26 | 27 | handle = dlopen(fname, RTLD_LAZY); 28 | if (handle == NULL) { 29 | sprintf(buf, "can't open %s", fname); 30 | xlfail(buf); 31 | } 32 | setvalue(s_cfun_table, 33 | cons(cvfixnum((FIXTYPE) handle), getvalue(s_cfun_table))); 34 | } 35 | 36 | LOCAL char *get_caddress(name) 37 | char *name; 38 | { 39 | LVAL next; 40 | void *handle; 41 | char *f; 42 | static int initialized = FALSE; 43 | static void *prog_handle = NULL; 44 | 45 | for (next = getvalue(s_cfun_table); consp(next); next = cdr(next)) { 46 | handle = (void *) getfixnum(car(next)); 47 | f = dlsym(handle, name); 48 | if (f != NULL) return(f); 49 | } 50 | if (! initialized) { 51 | prog_handle = dlopen(NULL, RTLD_LAZY); 52 | initialized = TRUE; 53 | } 54 | f = dlsym(prog_handle, name); 55 | return(f); 56 | } 57 | -------------------------------------------------------------------------------- /src/include/version.h: -------------------------------------------------------------------------------- 1 | #define XLS_MAJOR_RELEASE 3 2 | #define XLS_MINOR_RELEASE 52 3 | #define XLS_SUBMINOR_RELEASE 23 4 | #define XLS_RELEASE_STATUS " (Alpha)" 5 | -------------------------------------------------------------------------------- /src/include/xlconfig.h.in: -------------------------------------------------------------------------------- 1 | #define HAVE_FINITE 0 2 | #define HAVE_ISNAN 0 3 | #if HAVE_FINITE && HAVE_ISNAN 4 | # define IEEEFP 5 | #endif 6 | 7 | #define HAVE_MEMMOVE 0 8 | #if ! HAVE_MEMMOVE 9 | # define NOMEMMOVE 10 | #endif 11 | 12 | #define HAVE_DIFFTIME 0 13 | #if ! HAVE_DIFFTIME 14 | # define NODIFFTIME 15 | #endif 16 | 17 | #define HAVE_MATHERR 0 18 | #if HAVE_MATHERR 19 | # define USEMATHERR 20 | #endif 21 | 22 | #define HAVE_SIGSETJMP 0 23 | #if HAVE_SIGSETJMP 24 | # define XL_SETJMP(env) sigsetjmp(env,1) 25 | # define XL_LONGJMP(env,val) siglongjmp(env,val) 26 | # define XL_JMP_BUF sigjmp_buf 27 | #endif 28 | 29 | #define HAVE_FOREIGN 0 30 | #define HAVE_DLOPEN 0 31 | #if HAVE_FOREIGN 32 | # define FOREIGNCALL 33 | #endif 34 | 35 | #ifdef __STDC__ 36 | # define ANSI 37 | # if HAVE_DLOPEN 38 | # define SHAREDLIBS 39 | # endif 40 | #endif 41 | 42 | #define UNIX 43 | 44 | #ifdef _AIX 45 | # ifndef _BSD 46 | # define _BSD 47 | # endif 48 | #endif 49 | 50 | #ifdef __hpux 51 | # ifndef _HPUX_SOURCE 52 | # define _HPUX_SOURCE 53 | # endif 54 | #endif 55 | 56 | /* This is to bring in finite and isnan on newer versions of solaris */ 57 | #ifdef sun 58 | # ifndef __EXTENSIONS__ 59 | # define __EXTENSIONS__ 60 | # endif 61 | #endif 62 | -------------------------------------------------------------------------------- /src/include/xlmodule.h: -------------------------------------------------------------------------------- 1 | typedef struct { 2 | char *name; 3 | int numfunctions; 4 | VOID (**functions) _((int)); 5 | } MODULE; 6 | 7 | extern MODULE xlmodules[]; 8 | extern int xlnummodules; 9 | extern int xlcurrentmodule; 10 | 11 | VOID init_modules _((void)); 12 | -------------------------------------------------------------------------------- /src/include/xlshlib.h: -------------------------------------------------------------------------------- 1 | #ifdef _Windows 2 | #define XLGLOBAL __declspec(dllimport) 3 | #endif 4 | 5 | #include "xlisp.h" 6 | #define MVSUBR (SUBR + TYPEFIELD + 1) 7 | 8 | #define MAKEVERSION(major,minor) ((1L<<16) * major + minor) 9 | #define XLSHLIB_SYSVERSION {MAKEVERSION(0,1),MAKEVERSION(0,0)} 10 | #define XLSHLIB_VERSION_INFO(maj_cur,min_cur,maj_old,min_old) \ 11 | XLSHLIB_SYSVERSION, \ 12 | {MAKEVERSION(maj_cur,min_cur),MAKEVERSION(maj_old,min_old)} 13 | 14 | struct version_info { long current, oldest; }; 15 | 16 | typedef struct { char *name; FIXTYPE val; } FIXCONSTDEF; 17 | typedef struct { char *name; FLOTYPE val; } FLOCONSTDEF; 18 | typedef struct { char *name; char *val; } STRCONSTDEF; 19 | typedef struct { char *name; unsigned long val; } ULONGCONSTDEF; 20 | 21 | typedef struct { 22 | struct version_info sysversion; 23 | struct version_info modversion; 24 | FUNDEF *funs; 25 | FIXCONSTDEF *fixconsts; 26 | FLOCONSTDEF *floconsts; 27 | STRCONSTDEF *strconsts; 28 | ULONGCONSTDEF *ulongconsts; 29 | } xlshlib_modinfo_t; 30 | -------------------------------------------------------------------------------- /src/include/xlwrap.h: -------------------------------------------------------------------------------- 1 | LVAL xlw_lookup_type(char *tname); 2 | LVAL xlgacptr(LVAL type, int null_ok); 3 | void *xlgacptraddr(LVAL type, int null_ok); 4 | LVAL cvcptr(LVAL type, void *v, LVAL data); 5 | LVAL xlw_make_cptr(LVAL type, size_t elsize); 6 | LVAL xlw_cast_cptr(LVAL type); 7 | LVAL xlw_offset_cptr(LVAL type, size_t elsize); 8 | 9 | #define DECLARE_CPTR_TYPE(t) static LVAL xlw_##t##_type_tag=NULL; 10 | #define CPTR_TYPE(t) \ 11 | (xlw_##t##_type_tag == NULL ? \ 12 | xlw_##t##_type_tag = xlw_lookup_type(#t) : xlw_##t##_type_tag) 13 | #define cptrp(x) (consp(x)&&stringp(car(x))&&natptrp(cdr(x))) 14 | #define getcptype(x) car(x) 15 | #define getcpptr(x) cdr(x) 16 | #define getcpaddr(x) getnpaddr(getcpptr(x)) 17 | #define getcpprot(x) getnpprot(getcpptr(x)) 18 | #define newcptr(x,y) cons(x,y) 19 | #define cptr_type_p(p,t) \ 20 | (cptrp(p) && \ 21 | (getcptype(p) == (t) || getcptype(p) == CPTR_TYPE(void))) 22 | -------------------------------------------------------------------------------- /src/lsp/Makefile: -------------------------------------------------------------------------------- 1 | ############################################################################### 2 | ############################################################################### 3 | ### ### 4 | ### DO NOT EDIT THIS FILE ### 5 | ### ### 6 | ############################################################################### 7 | ############################################################################### 8 | 9 | XLSHOME = ../.. 10 | 11 | .SUFFIXES: .lsp .fsl 12 | 13 | .lsp.fsl: 14 | echo "(compile-file \"$<\") (exit)" | ${XLSHOME}/xlisp 15 | 16 | FSLFILES = init.fsl common.fsl common2.fsl common3.fsl help.fsl objects.fsl \ 17 | linalg.fsl stats.fsl dialogs.fsl graphics.fsl graph2.fsl graph3.fsl \ 18 | regress.fsl menus.fsl loadfsl.fsl conditns.fsl pathname.fsl \ 19 | shlib.fsl cmpload.fsl 20 | 21 | AUTOFSLFILES = oneway.fsl nonlin.fsl maximize.fsl bayes.fsl stepper.fsl \ 22 | glim.fsl 23 | 24 | CMPFSLFILES = compiler/backquot.fsl compiler/cmpmacro.fsl \ 25 | compiler/convert.fsl compiler/cells.fsl compiler/simplify.fsl \ 26 | compiler/lift.fsl compiler/gencode.fsl compiler/peephole.fsl \ 27 | compiler/assemble.fsl compiler/cmpfront.fsl 28 | 29 | xlisp.wks: ${XLSHOME}/xlisp ${CMPFSLFILES} ${FSLFILES} ${AUTOFSLFILES} 30 | rm -f xlisp.wks 31 | echo '(save-workspace "xlisp") (exit)' | ${XLSHOME}/xlisp 32 | cp ${AUTOFSLFILES} ${XLSHOME}/Autoload 33 | 34 | clean: 35 | rm -f core *~ *.fsl compiler/*.fsl xlisp.wks 36 | 37 | cleanall: clean 38 | distclean: cleanall 39 | -------------------------------------------------------------------------------- /src/lsp/cmpload.lsp: -------------------------------------------------------------------------------- 1 | (defpackage "XLSCMP" 2 | (:use "XLISP") 3 | (:import-from "XLISP" "*CMP-SETF*" "*CMP-STRUCTS*" "*CMP-GLOBAL-MACROS*" 4 | "*CMP-MACROS*" "*CMP-SPECIALS*" "ADD-METHOD")) 5 | 6 | (require (make-pathname :name "backquot" :directory '(:relative "compiler"))) 7 | (require (make-pathname :name "cmpmacro" :directory '(:relative "compiler"))) 8 | (require (make-pathname :name "convert" :directory '(:relative "compiler"))) 9 | (require (make-pathname :name "cells" :directory '(:relative "compiler"))) 10 | (require (make-pathname :name "simplify" :directory '(:relative "compiler"))) 11 | (require (make-pathname :name "lift" :directory '(:relative "compiler"))) 12 | (require (make-pathname :name "gencode" :directory '(:relative "compiler"))) 13 | (require (make-pathname :name "peephole" :directory '(:relative "compiler"))) 14 | (require (make-pathname :name "assemble" :directory '(:relative "compiler"))) 15 | (require (make-pathname :name "cmpfront" :directory '(:relative "compiler"))) 16 | -------------------------------------------------------------------------------- /src/lsp/cmpsys.lsp: -------------------------------------------------------------------------------- 1 | ;;;; 2 | ;;;; This file can be used to make .fsl files from .lsp files. 3 | ;;;; 4 | 5 | (defpackage "XLSCMP" 6 | (:use "XLISP") 7 | (:import-from "XLISP" "*CMP-SETF*" "ADD-METHOD" "CMP-DO-DEFSTRUCT")) 8 | 9 | (require "cmpload") 10 | 11 | (flet ((compile-if-needed (file &optional load) 12 | (let ((lspfile (merge-pathnames file ".lsp")) 13 | (fslfile (merge-pathnames file ".fsl"))) 14 | (unless (and (probe-file lspfile) 15 | (probe-file fslfile) 16 | (< (file-write-date lspfile) 17 | (file-write-date fslfile))) 18 | (compile-file file :load load))))) 19 | (let ((stdfiles '("common" "common2" "common3" "pathname" "help" "objects" 20 | "conditns" "shlib" "loadfsl")) 21 | (otherfiles '("init" "cmpload" "linalg" "stats" "dialogs" "graphics" 22 | "graph2" "graph3" "regress" "menus" "oneway" "nonlin" 23 | "maximize" "bayes" "stepper" "glim" 24 | #+msdos "dde")) 25 | (cmpfiles '("backquot" "cmpmacro" "convert" "cells" "simplify" 26 | "lift" "gencode" "peephole" "assemble" "cmpfront"))) 27 | (dolist (f cmpfiles) 28 | (let ((fn (make-pathname :name f :directory '(:relative "compiler")))) 29 | (compile-if-needed fn t))) 30 | (dolist (f stdfiles) (compile-if-needed f t)) 31 | (dolist (f otherfiles) (compile-if-needed f)))) 32 | 33 | (exit) 34 | -------------------------------------------------------------------------------- /src/lsp/compiler/README: -------------------------------------------------------------------------------- 1 | This directory contains the lisp code for the XLISP byte code 2 | compiler. The "virtual machine" for running the code is mainly in the 3 | file xlbcode.c in the C source directory. 4 | 5 | This compiler is based on CPS conversion (see, for example, Friedman, 6 | Wand and Haynes [2]). The design is based on the ORBIT compiler as 7 | described in Kranz et al. [3] and on Brooks, Gabriel and Steele [1]. 8 | 9 | At this point the compiler does not do anything special for vectorized 10 | arithmetic or anything else statistical. In the future I will explore 11 | adding optimizations designed to deal with problems specific to 12 | statistical usage. The basic design should make this reasonably easy. 13 | 14 | Currently the compiler ignores all declarations and all proclamations 15 | other than special ones. Future versions will use inline and optimize 16 | declarations to choose among code generation strategies. 17 | 18 | [1] Brooks, R. A., Gabriel, R. P, and Steele, G. L.} (1982), "An 19 | optimizing compiler for lexically scoped LISP," Proc. Symp. 20 | on Compiler Construction, ACM SIGPLAN Notices 17, 6, 261-275. 21 | [2] Friedman, D. P, Wand, M. and Haynes, C. T. (1992), Essentials 22 | of Programming Languages, Cambridge, MA: MIT Press. 23 | [3] Krantz, D. A., Kelsey, R., Rees, J. A., hudak, P., Philbin, J., 24 | and Adams, N. I. (1986), "Orbit: An optimizing compiler for 25 | Scheme," Proc. SIGPLAN '86 Symp. on Compiler Construction, 26 | SIGPLAN Notices 21, 7, 219-223. 27 | -------------------------------------------------------------------------------- /src/lsp/compiler/backquot.lsp: -------------------------------------------------------------------------------- 1 | ;;; Backquote Implementation from Common Lisp 2 | ;;; Author: Guy L. Steele Jr. Date: 27 December 1985 3 | ;;; This software is in the public domain 4 | 5 | 6 | ;;; TAA notes: 7 | ;;; Converted to XLISP from the CLtL book, July, 1991, by Tom Almy 8 | ;;; Expression simplification code removed. 9 | 10 | ;;; Reader Macros -- already exist for ` , and ,@ that generate correct 11 | ;;; code for this backquote implementation. 12 | 13 | ;;; This implementation will execute far slower than the XLISP original, 14 | ;;; but since macros expansions can replace the original code 15 | ;;; (at least with my modified XLISP implementation) 16 | ;;; most applications will run at their full speed after the macros have 17 | ;;; been expanded once. 18 | 19 | (in-package "XLISP") 20 | 21 | (defun bq-process (x) 22 | (cond ((atom x) (list 'quote x)) 23 | ((eq (car x) 'backquote) 24 | (bq-process (bq-process (cadr x)))) 25 | ((eq (car x) 'comma) (cadr x)) 26 | ((eq (car x) 'comma-at) 27 | (error ",@ after ` in ~s" (cadr x))) 28 | (t (do ((p x (cdr p)) 29 | (q '() (cons (bq-bracket (car p)) q))) 30 | ((atom p) 31 | (if (null p) ;; simplify if proper list TAA MOD 32 | (cons 'append (nreverse q)) 33 | (cons 'append 34 | (nconc (nreverse q) (list (list 'quote p)))))) 35 | (when (eq (car p) 'comma) 36 | (unless (null (cddr p)) (error "Malformed: ~s" p)) 37 | (return (cons 'append 38 | (nconc (nreverse q) 39 | (list (cadr p)))))) 40 | (when (eq (car p) 'comma-at) 41 | (error "Dotted ,@ in ~s" p)) 42 | )))) 43 | 44 | (defun bq-bracket (x) 45 | (cond ((atom x) 46 | (list 'list (list 'quote x))) 47 | ((eq (car x) 'comma) 48 | (list 'list (cadr x))) 49 | ((eq (car x) 'comma-at) 50 | (cadr x)) 51 | (t (list 'list (bq-process x))))) 52 | 53 | (defmacro backquote (x) 54 | (bq-process x)) 55 | 56 | (setq *features* (cons :backquote *features*)) 57 | -------------------------------------------------------------------------------- /src/lsp/compiler/cmpmacro.lsp: -------------------------------------------------------------------------------- 1 | (in-package "XLSCMP") 2 | 3 | ;;;; 4 | ;;;; Compiler Macro Expansion 5 | ;;;; 6 | 7 | ;;**** move to proper place? 8 | (defvar *cmp-macros* nil) 9 | (defvar *cmp-global-macros* nil) 10 | 11 | ;;**** think about precedence if macro and cmpmacro both exist 12 | ;;**** may simplify setf that way? 13 | 14 | (defun cmp-macroexpand (e &optional (env (list nil 15 | *cmp-fenv* 16 | *cmp-macros* 17 | *cmp-global-macros*))) 18 | (macroexpand e env)) 19 | 20 | (defun cmp-macroexpand-1 (e &optional (env (list nil 21 | *cmp-fenv* 22 | *cmp-macros* 23 | *cmp-global-macros*))) 24 | (macroexpand-1 e env)) 25 | 26 | 27 | ;;;; 28 | ;;;; Declaration Handling 29 | ;;;; 30 | 31 | (defun check-declarations (decls) 32 | (dolist (d decls) 33 | (dolist (i (rest d)) 34 | (if (and (consp i) (eq (first i) 'special)) 35 | (dolist (v (rest i)) 36 | (warn "special declaration for ~s ignored." v)))))) 37 | 38 | (defun split-declarations (x) 39 | (flet ((head-is-declaration (x) 40 | (and (consp (first x)) (eq (first (first x)) 'declare))) 41 | (head-is-docstring (x) (and (stringp (first x)) (consp (rest x))))) 42 | (do ((decls nil) 43 | (body x (rest body)) 44 | (doc nil)) 45 | (nil) 46 | (cond 47 | ((head-is-declaration body) (push (first body) decls)) 48 | ((head-is-docstring body) (setf doc (first body))) 49 | (t (check-declarations decls) 50 | #|(return (list (nreverse decls) body doc))|# 51 | (return (list nil body doc))))))) ; drop declarations for now 52 | 53 | 54 | ;;;; 55 | ;;;; PROGV 56 | ;;;; 57 | 58 | (define-compiler-macro progv (syms vals &rest body) 59 | `(%dynamic-bind ,syms ,vals #'(lambda () ,@body))) 60 | 61 | 62 | 63 | ;;;; 64 | ;;;; Macros for inlining some functions 65 | ;;;; ******* more needed here -- should these be here or as symbol-call-rules?? 66 | 67 | (define-compiler-macro not (x) `(if ,x nil t)) 68 | (define-compiler-macro null (x) `(if ,x nil t)) 69 | 70 | (define-compiler-macro row-major-aref (x i) `(aref ,x ,i)) 71 | (define-compiler-macro xlisp::%set-rm-aref (x i v) 72 | `(xlisp::%set-aref ,x ,i ,v)) 73 | -------------------------------------------------------------------------------- /src/lsp/loadfsl.lsp: -------------------------------------------------------------------------------- 1 | ;; 2 | ;; Some compiler/loader support 3 | ;; 4 | 5 | (in-package "XLISP") 6 | 7 | ;; needed by the compiler -- must appear before any defmeth's 8 | #+xlisp-stat 9 | (defun add-method (object name method doc) 10 | (if doc (send object :internal-doc name doc)) 11 | (send object :add-method name method)) 12 | 13 | ;; signal errors for old compiled defstructs 14 | (defun cmp-make-structure-constructor (structname) 15 | (declare (ignore structname)) 16 | (error "obsolete defstruct code -- file needs to be recompiled")) 17 | 18 | (defun cmp-do-defstruct (structname incopt others slotargs) 19 | (declare (ignore structname incopt others slotargs)) 20 | (error "obsolete defstruct code -- file needs to be recompiled")) 21 | 22 | ;; check fsl version 23 | (defconstant *fsl-major-version* 1) 24 | (defconstant *fsl-minor-version* 4) 25 | (defconstant *fsl-oldest-minor-version* 3) 26 | 27 | (defun check-fsl-version (major minor) 28 | (unless (and (= major *fsl-major-version*) 29 | (<= *fsl-oldest-minor-version* minor *fsl-minor-version*)) 30 | (error "file FSL version ~d.~d is not compatible with ~ 31 | system version ~d.~d" 32 | major minor 33 | *fsl-major-version* *fsl-minor-version*))) 34 | -------------------------------------------------------------------------------- /src/lsp/nongraph.lsp: -------------------------------------------------------------------------------- 1 | ;;;; 2 | ;;;; 3 | ;;;; Replacement Plotting Functions 4 | ;;;; 5 | ;;;; 6 | 7 | (setf (symbol-function 'plot-points) #'gnu-plot-points) 8 | (setf (symbol-function 'plot-lines) #'gnu-plot-lines) 9 | 10 | 11 | ;;;; 12 | ;;;; 13 | ;;;; Basic 2D Plotting Functions 14 | ;;;; 15 | ;;;; 16 | 17 | (defun plot-function (f xmin xmax &key (num-points 50) (type 'solid) labels) 18 | "Args: (f xmin xmax &optional (num-points 50) labels) 19 | Plots function F of one real variable over the range between xmin and xmax. 20 | The function is evaluated at NUM-POINTS points. LABELS is a list of axis 21 | labels." 22 | (let* ((x (rseq xmin xmax num-points)) 23 | (y (mapcar f x))) 24 | (plot-lines x y :type type :variable-labels labels))) 25 | 26 | ;;;; 27 | ;;;; 28 | ;;;; Quantile and Probability Plot Functions 29 | ;;;; 30 | ;;;; 31 | 32 | (defun quantile-plot (x &key (quantile-function #'normal-quant) 33 | (title "Quantile Plot") point-labels) 34 | "Args: (data &key (quantile-function #'normal-quant) (title \"Quantile Plot\") point-labels)" 35 | (plot-points (funcall quantile-function (/ (1+ (rank x)) (1+ (length x)))) 36 | x)) 37 | 38 | (defun probability-plot (x &key (distribution-function #'normal-cdf) 39 | (title "Probability Plot") point-labels) 40 | "Args: (data &key (distribution-function #'normal-cdf) (title \"Probability Plot\") point-labels)" 41 | (plot-points (/ (1+ (rank x)) (1+ (length x))) 42 | (funcall distribution-function x))) 43 | 44 | ;;;; 45 | ;;;; Disable everythinmg else 46 | ;;;; 47 | (defmacro defnongraph (sym) 48 | `(defun ,sym (&rest args) 49 | (error "~a is not available without windows" ',sym))) 50 | 51 | (defnongraph ok-or-cancel-dialog) 52 | (defnongraph message-dialog) 53 | (defnongraph get-string-dialog) 54 | (defnongraph get-value-dialog) 55 | (defnongraph choose-item-dialog) 56 | (defnongraph choose-subset-dialog) 57 | (defnongraph sequence-slider-dialog) 58 | (defnongraph interval-slider-dialog) 59 | (defnongraph close-all-plots) 60 | (defnongraph get-new-integer) 61 | (defnongraph linked-plots) 62 | (defnongraph active-graph-windows) 63 | (defnongraph color-symbols) 64 | (defnongraph cursor-symbols) 65 | (defnongraph plot-symbol-symbols) 66 | (defnongraph pause) 67 | (defnongraph link-views) 68 | (defnongraph unlink-views) 69 | (defnongraph spin-function) 70 | (defnongraph boxplot) 71 | (defnongraph boxplot-x) 72 | (defnongraph contour-function) 73 | -------------------------------------------------------------------------------- /src/lsp/shlib.lsp: -------------------------------------------------------------------------------- 1 | (defpackage "SHARED-LIBRARY" (:use "XLISP") (:nicknames "SHLIB")) 2 | (in-package "SHARED-LIBRARY") 3 | 4 | ;;;; 5 | ;;;; Data Structure for Library 6 | ;;;; 7 | 8 | (defstruct (shared-library 9 | (:constructor (make-shared-library (name path handle subrs))) 10 | (:print-function print-shlib)) 11 | name path handle subrs) 12 | 13 | (defun print-shlib (shlib stream depth) 14 | (format stream "#" (shared-library-name shlib))) 15 | 16 | 17 | ;;;; 18 | ;;;; Public Functions 19 | ;;;; 20 | 21 | (export '(load-shared-library close-shared-library 22 | shared-library-information)) 23 | 24 | (defun load-shared-library (path &optional 25 | (name (pathname-name path)) 26 | (version -1) 27 | (oldest version)) 28 | (let ((*package* *package*) 29 | (handle (shlib-open path)) 30 | (success nil)) 31 | (unwind-protect 32 | (let* ((init (shlib-symaddr handle (format nil "~a__init" name))) 33 | (ftab (call-by-address init)) 34 | (subrs (shlib-init ftab version oldest)) 35 | (shlib (make-shared-library name path handle subrs))) 36 | ;;(register-saver shlib #'close-shared-library) 37 | (setf success t) 38 | shlib) 39 | (unless success (shlib-close handle))))) 40 | 41 | (defun close-shared-library (shlib) 42 | ;;(unregister-saver shlib) 43 | (dolist (s (shared-library-subrs shlib)) 44 | (clear-subr s)) 45 | (shlib-close (shared-library-handle shlib))) 46 | 47 | (defun shared-library-information (path &optional (name (pathname-name path))) 48 | (let ((*package* *package*) 49 | (handle (shlib-open path))) 50 | (unwind-protect 51 | (let* ((init (shlib-symaddr handle (format nil "~a__init" name))) 52 | (ftab (call-by-address init))) 53 | (shlib-info ftab)) 54 | (shlib-close handle)))) 55 | -------------------------------------------------------------------------------- /tests/README: -------------------------------------------------------------------------------- 1 | This directory contains a set of tests adapted from the `thorough' 2 | tests in new S. 3 | 4 | To run the tests on a UNIX system, run xlisp (not xlispstat) from .. 5 | and do 6 | 7 | (load "tests/test") 8 | 9 | On a Macintosh, load the file test.lsp from the Tests folder. 10 | 11 | You may accasionally see a failure in "math" or "prob" because random 12 | data is used and I have not tuned things well enough yet to make these 13 | failures rare. 14 | 15 | To add new tests create a new file and add its name to the list defined 16 | at the top of tests.lsp. 17 | -------------------------------------------------------------------------------- /tests/arith.lsp: -------------------------------------------------------------------------------- 1 | ; tests of arithmetic, logical, and bit funcitons 2 | (setf eps 1.e-6) 3 | 4 | ;arith with integer args 5 | (check #'= (+ 1 3) (* 2 2)) 6 | (check #'= (- (list -3 1789) 20) (list -23 1769)) 7 | (check #'= (* (list -7 09 -7 09) (list 100 -10 1 -9)) (- (list 700 90 7 81))) 8 | (check #'< 9 | (abs (- (/ (list 5 3 1 340) 3) (list 1.6666667 1. .3333333 113.3333333))) 10 | eps) 11 | (check #'= (floor (/ (list 5 3 1 340) 3)) (list 1 1 0 113)) 12 | (check #'= (^ (list 12 35 159) 2) (list 144 1225 25281)) 13 | (check #'= (rem (list 86 -33 123456) 5) (list 1 -3 1)) 14 | 15 | ;arith with real or mixed args 16 | (check #'= (+ 15 .0078) 15.0078) 17 | (check #'< (abs (- (- (list 23.4 1 -50) 17) (list 6.4 -16 -67))) eps) 18 | (check #'< (abs (- (* 1.234e12 .02) 2.468e10)) eps) 19 | (check #'< (abs (- (/ (list 15 -2 1.e3) 7.2) 20 | (list 2.0833333 -.2777778 138.8888889))) 21 | eps) 22 | (check #'< (abs (- (rem 17.53 (list 5. 1.5)) (list 2.53 1.03))) eps) 23 | (check #'< (abs (- (^ (list 1.2 5.67) 2.001) (list 1.440263 32.204733))) eps) 24 | 25 | ;arith with double complex args 26 | (check #'= (+ 15 .0078e0) 15.0078) 27 | (check #'< 28 | (abs (- (- (list 23.4 1 -50) #c(17 5)) 29 | (list #c(6.4 -5) #c(-16 -5) #c(-67 -5)))) 30 | eps) 31 | (check #'< (abs (- (* 1.23456789012345e10 .02) 246913578.024690)) eps) 32 | (check #'< 33 | (abs (- (/ (list 15 -2. 1.e3) 7.2) 34 | (list 2.0833333 -.2777778 138.8888889))) 35 | eps) 36 | 37 | ;logical with integer args 38 | (check #'eq (< 5 (list 4 6 -5)) (list nil T nil)) 39 | (check #'eq (> (list 7 12345) 500) (list nil T)) 40 | (check #'eq (<= 17 (list 17 -1 100)) (list T nil T)) 41 | (check #'eq (>= -12 (list 500 0 -5 -12 -30)) (list nil nil nil T T)) 42 | (check #'eq (= (list 2 3 -3 4) (list 2 -3 -3 1)) (list T nil T nil)) 43 | 44 | ;logical with real or mixed arguments 45 | (check #'eq (< 5 (list 4.9 6.123 -5)) (list nil T nil)) 46 | (check #'eq (> (list 7.3 12345) 7.3) (list nil T)) 47 | (check #'eq (> (list 7.3 12345) 7.3) (list nil T)) 48 | (check #'eq (<= 1.17 (list 1.17 -1.1 100.1)) (list T nil T)) 49 | (check #'eq 50 | (>= -12.001 (list 500.001 0.001 -5.001 -12.001 -30)) 51 | (list nil nil nil T T)) 52 | (check #'eq (not T) nil) 53 | (check #'eq (not (and T nil)) T) 54 | (check #'= (if-else (> (iseq 1 3) 2) 100 0) (list 0 0 100)) 55 | -------------------------------------------------------------------------------- /tests/complex.lsp: -------------------------------------------------------------------------------- 1 | ; tests of complex number arithmetic 2 | (setf eps 1.e-12) 3 | 4 | (check #'= (+ #c(2 3) #c(4 2)) #c(6 5)) 5 | (check #'= (+ (- #c(2 3)) #c(4 2)) #c(2 -1)) 6 | (check #'= (- #c(2 3) #c(4 2)) (- #c(2 -1))) 7 | (check #'= (* (- #c(3 4)) #c(1 -2)) (- #c(11 -2))) 8 | (check #'< (abs (- (/ #c(2 1) #c(1 2)) (/ 4 5) (/ 3 #c(0 5)))) eps) 9 | (check #'< (abs (- (imagpart (* #c(3.4 2.5) #c(3.4 -2.5))) 0)) eps) 10 | (check #'< (abs (- (abs #c(2 -2)) (sqrt 8))) eps) 11 | (check #'< (abs (- (realpart (- #c(1.77 -3))) -1.77)) eps) 12 | (check #'< (abs (- (conjugate #c(9.03 -3.6)) #c(9.03 3.6))) eps) 13 | (check #'< (abs (- (phase #c(2 2)) (/ pi 4))) eps) 14 | (check #'= (complex 0 7) #c(0 7)) 15 | (check #'eql (if (complexp #c(4 0)) t nil) nil) 16 | (check #'eql (if (complexp #c(4.5 0)) t nil) t) 17 | (check #'= (cos (list pi (* 2 pi))) (cos (list (- pi) (- (* 2 pi))))) 18 | -------------------------------------------------------------------------------- /tests/manip.lsp: -------------------------------------------------------------------------------- 1 | ; test data manipulation and subsetting 2 | (setf eps 1.e-7 3 | xx (list 3 4.5 2 9 -6) 4 | yy (list 3 4 2 5 1) 5 | ll (combine (iseq 3 6) "jello" (list #c(1 1) #c(2 3)))) 6 | 7 | (check #'= 8 | (mapcar #'mean (list (list 1 3 4 2) (list 7 6 8 9))) (list 2.5 7.5)) 9 | 10 | (check #'< (abs (- (if-else (= yy 2) yy 0) (list 0 0 2 0 0))) eps) 11 | 12 | (let ((ord (order xx))) 13 | (check #'< (abs (- (sort-data xx) (select xx ord))) eps) 14 | (check #'< (abs (- (select yy ord) (iseq 1 5))) eps)) 15 | 16 | (check #'< (abs (- (select (repeat xx 3) 11) 4.5)) eps) 17 | (check #'< (abs (- (repeat xx 3) (combine xx xx xx))) eps) 18 | (check #'< (abs (- (select (repeat xx yy) (iseq 0 7)) 19 | (list 3 3 3 4.5 4.5 4.5 4.5 2))) eps) 20 | (check #'< (abs (- (select (reverse (repeat xx yy)) (iseq 0 7)) 21 | (list -6 9 9 9 9 9 2 2))) eps) 22 | 23 | #| 24 | all(split(c("a" "b" "c" "d") c(1 2 1 2))[[2]]==c("b" "d")) 25 | all(split(c("a" "b" "c" "d") c(1 2 1 2))$"2"==c("b" "d")) 26 | |# 27 | (check #'= (outer-product (iseq 1 3) (iseq 1 4)) 28 | (matrix '(3 4) (combine (iseq 1 4) (* 2 (iseq 1 4)) (* 3 (iseq 1 4))))) 29 | -------------------------------------------------------------------------------- /tests/prob.lsp: -------------------------------------------------------------------------------- 1 | ; test probability distributions and random number generators 2 | ; should do more extensive integration test 3 | 4 | (setf eps 2.e-4) 5 | 6 | (flet ((ptest (prob quant rand n &rest args) 7 | (let* ((x (apply rand n args)) 8 | (x1 (apply quant (apply prob x args) args))) 9 | (check #'< (abs (- x1 x)) (* eps (max (abs x))))))) 10 | (ptest #'beta-cdf #'beta-quant #'beta-rand 20 2 3) 11 | (ptest #'cauchy-cdf #'cauchy-quant #'cauchy-rand 20) 12 | (ptest #'chisq-cdf #'chisq-quant #'chisq-rand 20 2) 13 | (ptest #'gamma-cdf #'gamma-quant #'gamma-rand 20 5) 14 | (ptest #'normal-cdf #'normal-quant #'normal-rand 20) 15 | (ptest #'t-cdf #'t-quant #'t-rand 20 5) 16 | (ptest #'identity #'identity #'uniform-rand 20) 17 | (ptest #'f-cdf #'f-quant #'f-rand 20 2 3)) 18 | 19 | (labels ((trapezoid (from to n f args) 20 | (let* ((x (rseq from to n)) 21 | (w (append '(.5) (repeat 1 (- n 2)) '(.5))) 22 | (fvals (apply f x args))) 23 | (* (/ (- to from) (- n 1)) 24 | (sum (* fvals w))))) 25 | (int-test (dens quant &rest args) 26 | (check #'< 27 | (abs (- (trapezoid (apply quant .01 args) 28 | (apply quant .99 args) 29 | 500 30 | dens 31 | args) 32 | .98)) 33 | eps))) 34 | (int-test #'beta-dens #'beta-quant 1.5 3) 35 | (int-test #'cauchy-dens #'cauchy-quant) 36 | (int-test #'chisq-dens #'chisq-quant 3) 37 | (int-test #'gamma-dens #'gamma-quant 5) 38 | (int-test #'normal-dens #'normal-quant) 39 | (int-test #'t-dens #'t-quant 3) 40 | (int-test #'f-dens #'f-quant 7 45)) 41 | -------------------------------------------------------------------------------- /tests/rans.lsp: -------------------------------------------------------------------------------- 1 | (defun get-random-state-values (s) 2 | (second (read-from-string (prin1-to-string s) t nil :start 2))) 3 | 4 | (defun test-random-state (state values) 5 | (let ((*random-state* state) 6 | (state-max (aref (get-random-state-values *random-state*) 0))) 7 | (check #'= 8 | 0 9 | (mapcar #'(lambda (v) 10 | (random state-max) 11 | (- v (aref (get-random-state-values *random-state*) 1))) 12 | values)))) 13 | 14 | ; combined congruential 15 | (test-random-state '#$(1 #(2147483562 0 12345 67890)) 16 | '(2026359911 1950599823 315009702 1105313978 871469535 17 | 1575849876 94472070 728775444 2137747604 430227419)) 18 | 19 | ; superduper 20 | (test-random-state '#$(2 #(2147483647 0 0 12345 1 2354)) 21 | '(274318794 1445882217 174694986 21258797 860839904 22 | 1611788216 2056178182 1140888495 12651638 485726963)) 23 | 24 | ; combined tausworth 25 | (test-random-state '#$(3 #(2147483647 0 12345 67890)) 26 | '(702677384 51837197 1914342640 434186539 1381102196 27 | 1693194944 898066022 1288590140 645917234 1416028832)) 28 | 29 | 30 | 31 | -------------------------------------------------------------------------------- /tests/test.lsp: -------------------------------------------------------------------------------- 1 | (setf *test-files* 2 | (list "arith" "complex" "manip" "matrix" "matrix2" "blas" 3 | "math" "prob" "trig" "rans")) 4 | 5 | (setf *testdir* 6 | (make-pathname :directory (pathname-directory *load-pathname*) 7 | :device (pathname-device *load-pathname*) 8 | :host (pathname-device *load-pathname*))) 9 | 10 | 11 | (defun check (f a b) 12 | (flet ((as-list (x) 13 | (if (compound-data-p x) (coerce (element-seq x) 'list) (list x)))) 14 | (let ((res (as-list (map-elements f a b)))) 15 | (if (member nil res) 16 | (format t "test failed in ~s at ckeck ~d~%" 17 | *current-test-file* count))) 18 | (setf count (+ count 1)))) 19 | 20 | (dolist (f *test-files*) 21 | (progv '(*current-test-file* count) (list f 1) 22 | (load (merge-pathnames f *testdir*)))) 23 | 24 | -------------------------------------------------------------------------------- /tests/trig.lsp: -------------------------------------------------------------------------------- 1 | ; test trigonometric functions 2 | (setf eps 1.e-6 deg2rad (/ pi 180) rad2deg (/ 180 pi)) 3 | 4 | (check #'< (abs (- (* 2 pi rad2deg) 360)) eps) 5 | (check #'< (abs (- (* (atan (/ 1 1)) rad2deg) 45)) eps) 6 | (check #'< (abs (- (atan (/ 5 5)) (/ pi 4))) eps) 7 | (check #'< 8 | (abs (- (sqrt (+ (^ 2 2) (^ 3 2))) (/ 3 (sin (atan (/ 3 2)))))) eps) 9 | (check #'< 10 | (abs (- (cos (* pi .37)) (/ (sin (* pi .37)) (tan (* pi .37))))) eps) 11 | (check #'< (abs (- (cos (/ pi 4)) (sin (/ pi 4)))) eps) 12 | (check #'< (abs (- (acos -1) pi)) eps) 13 | (check #'< (abs (- (asin 1) (/ pi 2))) eps) 14 | 15 | ; fft test 16 | (let* ((n 1000) 17 | (x (normal-rand n))) 18 | (check #'< (max (abs (- x (/ (fft (fft x) t) n)))) eps)) 19 | -------------------------------------------------------------------------------- /xlisponly/Makefile.in: -------------------------------------------------------------------------------- 1 | prefix = @prefix@ 2 | exec_prefix = @exec_prefix@ 3 | 4 | LIBDIR=$(prefix)/lib/xlisp 5 | BINDIR=$(exec_prefix)/bin 6 | 7 | SRCDIR=.. 8 | 9 | all: 10 | (cd sources; $(MAKE) xlisp.bin) 11 | (cd compiler; $(MAKE)) 12 | (cd cmplsp; $(MAKE)) 13 | (cd sources; $(MAKE) xlisp.wks) 14 | sed "s:LIBDIR:./sources:" xlisp.sh > xlisp 15 | chmod +x xlisp 16 | 17 | 18 | install: 19 | -mkdir -p $(BINDIR) 20 | -mkdir -p $(LIBDIR) 21 | cp sources/xlisp.bin $(LIBDIR) 22 | cp sources/xlisp.wks $(LIBDIR) 23 | sed "s:LIBDIR:$(LIBDIR):" xlisp.sh > $(BINDIR)/xlisp 24 | chmod +x $(BINDIR)/xlisp 25 | 26 | 27 | clean: 28 | (cd sources; $(MAKE) clean) 29 | (cd cmplsp; $(MAKE) clean) 30 | (cd compiler; $(MAKE) clean) 31 | 32 | 33 | # this is used for creating the separate xlisp only distribution 34 | srcfiles: 35 | (cd sources; $(MAKE) -f Makefile.in SRCDIR=$(SRCDIR) srcfiles) 36 | (cd cmplsp; $(MAKE) SRCDIR=$(SRCDIR) srcfiles) 37 | (cd compiler; $(MAKE) SRCDIR=$(SRCDIR) srcfiles) 38 | -------------------------------------------------------------------------------- /xlisponly/cmplsp/Makefile: -------------------------------------------------------------------------------- 1 | SRCDIR=../.. 2 | 3 | SRC=common.lsp common2.lsp common3.lsp conditns.lsp loadfsl.lsp pathname.lsp \ 4 | stepper.lsp shlib.lsp 5 | 6 | FSL=common.fsl common2.fsl common3.fsl conditns.fsl loadfsl.fsl pathname.fsl \ 7 | stepper.fsl shlib.fsl 8 | 9 | .SUFFIXES: .lsp .fsl 10 | 11 | .lsp.fsl: 12 | echo "(compile-file \"$<\") (exit)" \ 13 | | ../sources/xlisp.bin ../sources/cmpload 14 | 15 | all: $(FSL) 16 | 17 | $(FSL): $(SRC) 18 | 19 | # this is used if compiling in a subdirectory of the xlispstat tree 20 | $(SRC): 21 | ln -s $(SRCDIR)/$@ $@ 22 | 23 | # this is used for creating the separate xlisp only distribution 24 | srcfiles: 25 | (cd $(SRCDIR); tar cf - $(SRC)) | tar xf - 26 | 27 | clean: 28 | rm -f *.fsl 29 | -------------------------------------------------------------------------------- /xlisponly/compiler/Makefile: -------------------------------------------------------------------------------- 1 | SRCDIR=../.. 2 | 3 | SRC=backquot.lsp cmpmacro.lsp convert.lsp cells.lsp simplify.lsp lift.lsp \ 4 | gencode.lsp peephole.lsp assemble.lsp cmpfront.lsp 5 | 6 | FSL=backquot.fsl cmpmacro.fsl convert.fsl cells.fsl simplify.fsl lift.fsl \ 7 | gencode.fsl peephole.fsl assemble.fsl cmpfront.fsl 8 | 9 | CMPLSP=../cmplsp/common.lsp ../cmplsp/conditns.lsp ../cmplsp/loadfsl.lsp 10 | 11 | all: $(FSL) 12 | 13 | $(CMPLSP): 14 | (cd ../cmplsp; $(MAKE) common.lsp conditns.lsp loadfsl.lsp) 15 | 16 | $(FSL): $(SRC) $(CMPLSP) 17 | 18 | .SUFFIXES: .lsp .fsl 19 | 20 | .lsp.fsl: 21 | echo "(compile-file \"$<\") (exit)" \ 22 | | ../sources/xlisp.bin ../sources/cmpload 23 | 24 | # this is used if compiling in a subdirectory of the xlispstat tree 25 | $(SRC): 26 | ln -s $(SRCDIR)/compiler/$@ $@ 27 | 28 | # this is used for creating the separate xlisp only distribution 29 | srcfiles: 30 | (cd $(SRCDIR)/compiler; tar cf - $(SRC) README) | tar xf - 31 | 32 | clean: 33 | rm -f *.fsl 34 | -------------------------------------------------------------------------------- /xlisponly/configure.in: -------------------------------------------------------------------------------- 1 | AC_INIT(Makefile.in) 2 | AC_CONFIG_AUX_DIR(sources/config) 3 | AC_CONFIG_SUBDIRS(sources) 4 | AC_OUTPUT(Makefile) 5 | -------------------------------------------------------------------------------- /xlisponly/lsp/ackerman.lsp: -------------------------------------------------------------------------------- 1 | (defun ack (m n) 2 | (cond ((zerop m) (1+ n)) 3 | ((zerop n) (ack (1- m) 1)) 4 | ((ack (1- m) (ack m (1- n)))))) 5 | -------------------------------------------------------------------------------- /xlisponly/lsp/art.lsp: -------------------------------------------------------------------------------- 1 | ; This is an example using the object-oriented programming support in 2 | ; XLISP. The example involves defining a class of objects representing 3 | ; dictionaries. Each instance of this class will be a dictionary in 4 | ; which names and values can be stored. There will also be a facility 5 | ; for finding the values associated with names after they have been 6 | ; stored. 7 | 8 | ; Create the 'Dictionary' class and establish its instance variable list. 9 | ; The variable 'entries' will point to an association list representing the 10 | ; entries in the dictionary instance. 11 | 12 | (setq Dictionary (send Class :new '(entries))) 13 | 14 | ; Setup the method for the ':isnew' initialization message. 15 | ; This message will be send whenever a new instance of the 'Dictionary' 16 | ; class is created. Its purpose is to allow the new instance to be 17 | ; initialized before any other messages are sent to it. It sets the value 18 | ; of 'entries' to nil to indicate that the dictionary is empty. 19 | 20 | (send Dictionary :answer :isnew '() 21 | '((setq entries nil) 22 | self)) 23 | 24 | ; Define the message ':add' to make a new entry in the dictionary. This 25 | ; message takes two arguments. The argument 'name' specifies the name 26 | ; of the new entry; the argument 'value' specifies the value to be 27 | ; associated with that name. 28 | 29 | (send Dictionary :answer :add '(name value) 30 | '((setq entries 31 | (cons (cons name value) entries)) 32 | value)) 33 | 34 | ; Create an instance of the 'Dictionary' class. This instance is an empty 35 | ; dictionary to which words may be added. 36 | 37 | (setq d (send Dictionary :new)) 38 | 39 | ; Add some entries to the new dictionary. 40 | 41 | (send d :add 'mozart 'composer) 42 | (send d :add 'winston 'computer-scientist) 43 | 44 | ; Define a message to find entries in a dictionary. This message takes 45 | ; one argument 'name' which specifies the name of the entry for which to 46 | ; search. It returns the value associated with the entry if one is 47 | ; present in the dictionary. Otherwise, it returns nil. 48 | 49 | (send Dictionary :answer :find '(name &aux entry) 50 | '((cond ((setq entry (assoc name entries)) 51 | (cdr entry)) 52 | (t 53 | nil)))) 54 | 55 | ; Try to find some entries in the dictionary we created. 56 | 57 | (send d :find 'mozart) 58 | (send d :find 'winston) 59 | (send d :find 'bozo) 60 | 61 | ; The names 'mozart' and 'winston' are found in the dictionary so their 62 | ; values 'composer' and 'computer-scientist' are returned. The name 'bozo' 63 | ; is not found so nil is returned in this case. 64 | -------------------------------------------------------------------------------- /xlisponly/lsp/backquot.lsp: -------------------------------------------------------------------------------- 1 | ;;; Backquote Implementation from Common Lisp 2 | ;;; Author: Guy L. Steele Jr. Date: 27 December 1985 3 | ;;; This software is in the public domain 4 | 5 | 6 | ;;; TAA notes: 7 | ;;; Converted to XLISP from the CLtL book, July, 1991, by Tom Almy 8 | ;;; Expression simplification code removed. 9 | 10 | ;;; Reader Macros -- already exist for ` , and ,@ that generate correct 11 | ;;; code for this backquote implementation. 12 | 13 | ;;; This implementation will execute far slower than the XLISP original, 14 | ;;; but since macros expansions can replace the original code 15 | ;;; (at least with my modified XLISP implementation) 16 | ;;; most applications will run at their full speed after the macros have 17 | ;;; been expanded once. 18 | 19 | 20 | (in-package :xlisp) 21 | 22 | (defmacro backquote (x) 23 | (bq-process x)) 24 | 25 | (defun bq-process (x) 26 | (cond ((atom x) (list 'quote x)) 27 | ((eq (car x) 'backquote) 28 | (bq-process (bq-process (cadr x)))) 29 | ((eq (car x) 'comma) (cadr x)) 30 | ((eq (car x) 'comma-at) 31 | (error ",@ after ` in ~s" (cadr x))) 32 | (t (do ((p x (cdr p)) 33 | (q '() (cons (bq-bracket (car p)) q))) 34 | ((atom p) 35 | (if (null p) ;; simplify if proper list TAA MOD 36 | (cons 'append (nreverse q)) 37 | (cons 'append 38 | (nconc (nreverse q) (list (list 'quote p)))))) 39 | (when (eq (car p) 'comma) 40 | (unless (null (cddr p)) (error "Malformed: ~s" p)) 41 | (return (cons 'append 42 | (nconc (nreverse q) 43 | (list (cadr p)))))) 44 | (when (eq (car p) 'comma-at) 45 | (error "Dotted ,@ in ~s" p)) 46 | )))) 47 | 48 | (defun bq-bracket (x) 49 | (cond ((atom x) 50 | (list 'list (list 'quote x))) 51 | ((eq (car x) 'comma) 52 | (list 'list (cadr x))) 53 | ((eq (car x) 'comma-at) 54 | (cadr x)) 55 | (t (list 'list (bq-process x))))) 56 | 57 | (setq *features* (cons :backquote *features*)) 58 | -------------------------------------------------------------------------------- /xlisponly/lsp/change.lsp: -------------------------------------------------------------------------------- 1 | ; Allow max of 9 of each coin 2 | (defun change (quan &optional (coins '(25 10 5 1)) &aux result) 3 | (cond ((zerop quan) (list nil)) 4 | ((null coins) t) 5 | ((> (first coins) quan) (change quan (rest coins))) 6 | (t (dotimes (i (1+ (min 9 (/ quan (first coins))))) 7 | (let ((res (change (- quan (* i (first coins))) 8 | (rest coins)))) 9 | (when (listp res) 10 | (if (zerop i) 11 | (setq result (append res result)) 12 | (setq result (append (mapcar #'(lambda (x) (cons (list i (car coins)) x)) 13 | res) 14 | result)))))) 15 | (if (null result) t result)))) 16 | -------------------------------------------------------------------------------- /xlisponly/lsp/dragon.lsp: -------------------------------------------------------------------------------- 1 | ;; DRAGON.L FOR PC-LISP V2.10 2 | ;; Modified for xlisp 2.1d (w. graphics extensions) by Tom Almy 3 | ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~ 4 | ;; Draw an Nth order Dragon Curve requires Turtle.l routines to run. 5 | ;; Taken From Byte April 1986. Try (DragonCurve 16) then put on supper, 6 | ;; watch the news and come back in an hour and see the results. It takes 7 | ;; about 1/2 hour on my machine so on a normal IBM-PC it should take about 8 | ;; an 1.5 hours. 9 | ;; 10 | ;; Peter Ashwood-Smith. 11 | ;; April 1986 12 | ;; 13 | ;; P.S - This dragon is nicknamed "spot" 14 | 15 | #-:turtle (load "turtle") 16 | 17 | (defvar *StepSize* 1) 18 | 19 | (defun Dragon(sign level) 20 | (if (zerop level) 21 | (TurtleForward *StepSize*) 22 | (progn 23 | (setq level (1- level)) 24 | (TurtleRight (* 45 sign)) 25 | (Dragon -1 level) 26 | (TurtleLeft (* 90 sign)) 27 | (Dragon 1 level) 28 | (TurtleRight (* 45 sign)) 29 | ) 30 | ) 31 | ) 32 | 33 | (defun DragonCurve (n m) 34 | (setq *StepSize* m) ; *StepSize* is global variable 35 | (TurtleGraphicsUp) 36 | (TurtleCenter) 37 | (TurtleGoto 50 50) 38 | (TurtleRight 30) ; angle the serpent a bit 39 | (Dragon 1 n) 40 | (gc) 41 | ) 42 | 43 | (print "Try (DragonCurve 14 1)") 44 | -------------------------------------------------------------------------------- /xlisponly/lsp/edit.lsp: -------------------------------------------------------------------------------- 1 | #+:packages 2 | (unless (find-package "TOOLS") 3 | (make-package "TOOLS" :use '("XLISP"))) 4 | 5 | (in-package "TOOLS") 6 | 7 | (export '(edit)) 8 | 9 | ;;; 10 | ;;; This variable is the default file to edit 11 | ;;; 12 | 13 | (defvar *edit-file* "") 14 | 15 | (defvar *editor* "epsilon") 16 | 17 | ;;; 18 | ;;; edit a file using the specified editor 19 | ;;; if the file editted was a lisp file (.lsp) load it 20 | ;;; 21 | 22 | ;; Two versions, the first works when position-if exists and does a better 23 | ;; job 24 | 25 | #+:posfcns (defmacro edit (&optional file &aux rfile) 26 | (read-char) 27 | (when file (setq *edit-file* (string file))) 28 | (setq rfile (reverse *edit-file*)) 29 | (when (null (position-if #'(lambda (x) (eq x #\.)) 30 | rfile 31 | :end 32 | (position-if #'(lambda (x) 33 | (or (eq x #\\) (eq x #\/))) 34 | rfile))) 35 | (setq *edit-file* (strcat *edit-file* ".lsp"))) 36 | (unless (system (strcat *editor* " " *edit-file*)) 37 | (error "Unable to execute: ~a ~a" *editor* *edit-file*)) 38 | (let ((len (length *edit-file*))) 39 | (when (and (> len 4) 40 | (string= (string-downcase (subseq *edit-file* (- len 4))) 41 | ".lsp")) 42 | (list 'load *edit-file*)))) 43 | 44 | #-:posfcns (defmacro edit (&optional file) 45 | (read-char) 46 | (when file (setq *edit-file* (string file))) 47 | (when (not (member #\. 48 | (get-output-stream-list 49 | (make-string-input-stream *edit-file*)))) 50 | (setq *edit-file* (strcat *edit-file* ".lsp"))) 51 | (unless (system (strcat *editor* " " *edit-file*)) 52 | (error "Unable to execute: ~a ~a" *editor* *edit-file*)) 53 | (let ((len (length *edit-file*))) 54 | (when (and (> len 4) 55 | (string= (string-downcase (subseq *edit-file* (- len 4))) 56 | ".lsp")) 57 | (list 'load *edit-file*)))) 58 | -------------------------------------------------------------------------------- /xlisponly/lsp/evalenv.lsp: -------------------------------------------------------------------------------- 1 | ;; 2 | ;; The EVAL function in the original XLISP evaluated in the current lexical 3 | ;; context. This was changed to evaluate in the NIL (global) context to 4 | ;; match Common Lisp. But this created a problem: how do you EVAL an 5 | ;; expression in the current lexical context? 6 | ;; 7 | ;; The answer is you can use the evalhook facility. The evalhook function 8 | ;; will evaluate an expression using an environment given to it as an 9 | ;; argument. But then the problem is "how do you get the current 10 | ;; environment?" Well the getenv macro, below obtains the environent by 11 | ;; using an *evalhook* form. 12 | ;; 13 | ;; The following two macros do the job. Insteading of executing (eval ) 14 | ;; just execute (eval-env ). If you want, you can dispense with the 15 | ;; macros and execute: 16 | ;; 17 | ;;(evalhook nil nil (let ((*evalhook* (lambda (x env) env))) 18 | ;; (eval nil))) 19 | ;; 20 | ;; Tom Almy 10/91 21 | ;; 22 | 23 | (defmacro getenv () 24 | '(let ((*evalhook* (lambda (x env) env))) 25 | (eval nil))) ; hook function evaluates by returning 26 | ; environment 27 | 28 | (defmacro eval-env (arg) ; evaluate in current environment 29 | `(evalhook ,arg nil nil (getenv))) 30 | 31 | 32 | -------------------------------------------------------------------------------- /xlisponly/lsp/example.lsp: -------------------------------------------------------------------------------- 1 | #-:classes (load "classes") 2 | 3 | ; Make the class ship and its instance variables be known 4 | 5 | (defclass ship ((x 0) (y 0) (xv 0) (yv 0) (mass 0) (name 'unknown) 6 | (captain 'unknown) (registry 'unknown))) 7 | 8 | (defmethod ship :sail (time) 9 | ; the METHOD for sailing 10 | (princ (list "sailing for " time " hours\n")) 11 | ; note that this form is expressed in terms of objects: "self" 12 | ; is bound to the object being talked to during the execution 13 | ; of its message. It can ask itself to do things. 14 | (setf (send self :x) 15 | (+ (send self :x) (* (send self :xv) time))) 16 | ; This form performs a parallel action to the above, but more 17 | ; efficiently, and in this instance, more clearly 18 | (setq y (+ y (* yv time))) 19 | ; Cute message for return value. Tee Hee. 20 | "Sailing, sailing, over the bountiful chow mein...") 21 | 22 | ; is not terribly instructive. How about a more 23 | ; informative print routine? 24 | 25 | (defmethod ship :print () (princ (list 26 | "SHIP NAME: " (send self :name) "\n" 27 | "REGISTRY: " (send self :registry) "\n" 28 | "CAPTAIN IS: " (send self :captain) "\n" 29 | "MASS IS: " (send self :mass) " TONNES\n" 30 | "CURRENT POSITION IS: " 31 | (send self :x) " X BY " 32 | (send self :y) " Y\n" 33 | "SPEED IS: " 34 | (send self :xv) " XV BY " 35 | (send self :yv) " YV\n") ) ) 36 | 37 | 38 | ; and an example object. 39 | 40 | (definst ship Bounty :mass 50 41 | :name 'Bounty 42 | :registry 'England 43 | :captain 'Bligh) 44 | 45 | (send Bounty :print) 46 | 47 | (definst ship lollipop :mass (+ 10 20) :captain 'Temple :x 1000 :y 2000) 48 | 49 | (send lollipop :print) 50 | 51 | (definst ship hard :mass 1000 :captain 'Bozo :registry 'North-pole ) 52 | 53 | (send hard :print) 54 | -------------------------------------------------------------------------------- /xlisponly/lsp/fact.lsp: -------------------------------------------------------------------------------- 1 | (defun fact (n) 2 | (cond ((zerop n) 1) 3 | ((= n 1) 1) 4 | (t (* n (fact (- n 1)))))) 5 | (defun facti (n &aux (v 1)) ;; Iterative version 6 | (dotimes (i n) (setq v (* v (1+ i)))) 7 | v) 8 | -------------------------------------------------------------------------------- /xlisponly/lsp/fib.lsp: -------------------------------------------------------------------------------- 1 | (defun fib (x) 2 | (if (< x 2) 3 | x 4 | (+ (fib (1- x)) (fib (- x 2))))) 5 | 6 | (defun fibi (n) 7 | (do ((i 1 (1+ i)) 8 | (fib-i-1 0 fib-i) 9 | (fib-i 1 (+ fib-i fib-i-1))) 10 | ((= i n) fib-i))) 11 | -------------------------------------------------------------------------------- /xlisponly/lsp/hanoi.lsp: -------------------------------------------------------------------------------- 1 | ; Good ol towers of hanoi 2 | ; 3 | ; Usage: 4 | ; (hanoi ) 5 | ; - an integer the number of discs 6 | 7 | (defun hanoi(n) 8 | ( transfer 'A 'B 'C n )) 9 | 10 | (defun print-move ( from to ) 11 | (princ "Move Disk From ") 12 | (princ from) 13 | (princ " To ") 14 | (princ to) 15 | (princ "\n") 16 | nil) 17 | 18 | 19 | (defun transfer ( from to via n ) 20 | (cond ((equal n 1) (print-move from to )) 21 | (t (transfer from via to (- n 1)) 22 | (print-move from to) 23 | (transfer via to from (- n 1))))) 24 | 25 | 26 | -------------------------------------------------------------------------------- /xlisponly/lsp/infix.lsp: -------------------------------------------------------------------------------- 1 | ;;; 2 | ;;; An infix to prefix converter for algebraic expressions. 3 | ;;; From Winston and Horn, Second Edition, pp 185-189. 4 | ;;; 5 | ; 6 | ; Adapted as a lisp macro by: 7 | ; Jonathan Roger Greenblatt (jonnyg@rover.umd.edu) 8 | ; University of Maryland at College Park 9 | ; 10 | ; 11 | ; (usage: 12 | ; 13 | ; [ ( ) ... ] 14 | ; 15 | ; : a lisp expresion. 16 | ; : =,+,-,*,/,mod.**,^ 17 | ; 18 | ; Note: [ and ] are part of the syntax, ( and ) mean this part is 19 | ; optional. 20 | ; 21 | ; Examples: 22 | ; 23 | ; [a = 7 * 5 + 4] 24 | ; [b = 7 + (sin (float a)) + (float [a / 7]) * [3 + a]] 25 | ; 26 | ; These are expanded to: 27 | ; 28 | ; (SETQ A (+ (* 7 5) 4)) 29 | ; (SETQ B (+ (+ 7 (SIN (FLOAT A))) (* (FLOAT (/ A 7)) (+ 3 A)))) 30 | ; 31 | ; 32 | 33 | (defun inf-to-pre (ae) 34 | (labels 35 | ((weight (operator) 36 | (case operator 37 | (= 0) 38 | (+ 1) 39 | (- 1) 40 | (* 2) 41 | (/ 2) 42 | (mod 2) 43 | (** 3) 44 | (^ 3) 45 | (t 4))) 46 | 47 | (opcode (operator) 48 | (case operator 49 | (= 'setq) 50 | (+ '+) 51 | (- '-) 52 | (* '*) 53 | (/ '/) 54 | (mod 'mod) 55 | (** 'expt) 56 | (^ 'expt) 57 | (t (error "~s is an invalid operator" operator)))) 58 | 59 | (inf-aux (ae operators operands) 60 | (inf-iter (cdr ae) 61 | operators 62 | (cons (car ae) operands))) 63 | 64 | (inf-iter (ae operators operands) 65 | (cond ((and (null ae) (null operators)) 66 | (car operands)) 67 | ((and (not (null ae)) 68 | (or (null operators) 69 | (> (weight (car ae)) 70 | (weight (car operators))))) 71 | (inf-aux (cdr ae) 72 | (cons (car ae) operators) 73 | operands)) 74 | (t (inf-iter ae 75 | (cdr operators) 76 | (cons (list (opcode (car operators)) 77 | (cadr operands) 78 | (car operands)) 79 | (cddr operands))))))) 80 | 81 | (if (atom ae) 82 | ae 83 | (inf-aux ae nil nil)))) 84 | 85 | (setf (aref *readtable* (char-int #\[)) 86 | (cons :tmacro 87 | (lambda (f c &aux ex) 88 | (setf ex nil) 89 | (do () ((eq (peek-char t f) #\])) 90 | (setf ex (append ex (cons (read f) nil)))) 91 | (read-char f) 92 | (cons (inf-to-pre ex) nil)))) 93 | 94 | (setf (aref *readtable* (char-int #\])) 95 | (cons :tmacro 96 | (lambda (f c) 97 | (error "misplaced right bracket")))) 98 | 99 | 100 | -------------------------------------------------------------------------------- /xlisponly/lsp/makewks.lsp: -------------------------------------------------------------------------------- 1 | ; Many people have had trouble creating an initial workspace where the tools 2 | ; package is accessable. This sample LSP file will create a workspace which 3 | ; will be loaded by default. 4 | ; To build, delete any existing xlisp.wks file, run xlisp, and then load 5 | ; this file. You may want to customize for the actual tools you want. 6 | (expand 5) ; Or whatever you want -- object here is to make 7 | ; an enlarged image to reduce garbage collections. 8 | (load "common") ; Common Lisp extensions 9 | (load "classes") ; Classes 10 | (load "stepper") ; Stepper tool, STEP 11 | (load "pp") ; Pretty printer tool 12 | (load "common2") ; more Common Lisp extensions 13 | (load "inspect") ; Inspector (has INSPECT and DESCRIBE) 14 | ;(load "repair") ; Old version of Inspect 15 | (use-package :tools) ; makes package :tools accessable 16 | (load "document") ; Glossary (glos.txt must be in current directory) 17 | ; and DOCUMENTATION function 18 | ; Instead of "document", you might want "glos" 19 | ;(load "glos") ; Glossary, without documentation function 20 | (save "xlisp") ; save image 21 | 22 | -------------------------------------------------------------------------------- /xlisponly/lsp/matrix.lsp: -------------------------------------------------------------------------------- 1 | ; Matrix functions by Tom Almy 2 | ; Multidimensional arrays are implemented here as arrays of arrays 3 | ; make-array is redefined to mimic common lisp 4 | ; Unfortunately AREF cannot be changed since its operation in setf is 5 | ; "wired in", so we will use a new (macro) function MREF 6 | 7 | 8 | (when (eq (type-of (symbol-function 'make-array)) 9 | 'subr) 10 | (setf (symbol-function 'orig-make-array) 11 | (symbol-function 'make-array))) 12 | 13 | (defun make-array (dims &key initial) 14 | (cond ((null dims) initial) 15 | ((atom dims) (make-array (list dims) :initial initial)) 16 | (t (let ((result (orig-make-array (first dims)))) 17 | (when (or (rest dims) initial) 18 | (dotimes (i (first dims)) 19 | (setf (aref result i) 20 | (make-array (rest dims) :initial initial)))) 21 | result)))) 22 | 23 | (defun mref (matrix &rest indices) 24 | (dolist (index indices) 25 | (setq matrix (aref matrix index))) 26 | matrix) 27 | 28 | (setf (get 'mref '*setf*) 29 | #'(lambda (mat &rest arglist) 30 | (do ((index (first arglist) (first remainder)) 31 | (remainder (rest arglist) (rest remainder))) 32 | ((null (rest remainder)) 33 | (setf (aref mat index) (first remainder))) 34 | (setf mat (aref mat index))))) 35 | 36 | -------------------------------------------------------------------------------- /xlisponly/lsp/memo.lsp: -------------------------------------------------------------------------------- 1 | ;;; 2 | ;;; The Memoization facility, from Norvig's "Paradigms of Artificial 3 | ;;; Intelligence Programming. 4 | ;;; Adapted for XLisp by Leo Sarasua (modifications marked LSG) 5 | 6 | (provide 'memo) 7 | 8 | (defmacro defun-memo (fn args &rest body) ; LSG 9 | "Define a memoized function." 10 | `(memoize (defun ,fn ,args . ,body))) 11 | 12 | (defun memo (fn &key (key #'first) (test #'eql) name) 13 | "Return a memo-function of fn." 14 | (let ((table (make-hash-table :test test))) 15 | (setf (get name 'memo) table) 16 | #'(lambda (&rest args) 17 | (let ((k (funcall key args))) 18 | (multiple-value-bind (val found-p) 19 | (gethash k table) 20 | (if found-p val 21 | (setf (gethash k table) (apply fn args)))))))) 22 | 23 | (defun memoize (fn-name &key (key #'first) (test #'eql)) 24 | "Replace fn-name's global definition with a memoized version." 25 | (clear-memoize fn-name) 26 | (setf (symbol-function fn-name) 27 | (memo (symbol-function fn-name) 28 | :name fn-name :key key :test test))) 29 | 30 | (defun clear-memoize (fn-name) 31 | "Clear the hash table from a memo function." 32 | (let ((table (get fn-name 'memo))) 33 | (when table (clrhash table)))) 34 | 35 | -------------------------------------------------------------------------------- /xlisponly/lsp/queens.lsp: -------------------------------------------------------------------------------- 1 | ; 2 | ; Place n queens on a board 3 | ; See Winston and Horn Ch. 11 4 | ; 5 | ; Usage: 6 | ; (queens ) 7 | ; where is an integer -- the size of the board - try (queens 4) 8 | 9 | ; Do two queens threaten each other ? 10 | (defun threat (i j a b) 11 | (or (eql i a) ;Same row 12 | (eql j b) ;Same column 13 | (eql (- i j) (- a b)) ;One diag. 14 | (eql (+ i j) (+ a b)))) ;the other diagonal 15 | 16 | ; Is position (n,m) on the board not safe for a queen ? 17 | (defun conflict (n m board) 18 | (cond ((null board) nil) 19 | ((threat n m (caar board) (cadar board)) t) 20 | (t (conflict n m (cdr board))))) 21 | 22 | 23 | ; Place queens on a board of size SIZE 24 | (defun queens (size) 25 | (prog (board n m) 26 | (setq board nil) 27 | (setq n 1) ;Try the first row 28 | loop-n 29 | (setq m 1) ;Column 1 30 | loop-m 31 | (cond ((conflict n m board) (go un-do-m))) ;Check for conflict 32 | (setq board (cons (list n m) board)) ; Add queen to board 33 | (cond ((> (setq n (1+ n)) size) ; Placed N queens ? 34 | (print (reverse board)))) ; Print config 35 | (go loop-n) ; Next row which column? 36 | un-do-n 37 | (cond ((null board) (return 'Done)) ; Tried all possibilities 38 | (t (setq m (cadar board)) ; No, Undo last queen placed 39 | (setq n (caar board)) 40 | (setq board (cdr board)))) 41 | 42 | un-do-m 43 | (cond ((> (setq m (1+ m)) size) ; Go try next column 44 | (go un-do-n)) 45 | (t (go loop-m))))) 46 | -------------------------------------------------------------------------------- /xlisponly/lsp/queens2.lsp: -------------------------------------------------------------------------------- 1 | ; queens2.lsp 2 | ; 3 | ; Place n queens on a board (graphical version) 4 | ; See Winston and Horn Ch. 11 5 | ; 6 | ; Usage: 7 | ; (queens ) 8 | ; where is an integer -- the size of the board - try (queens 4) 9 | 10 | ; Do two queens threaten each other ? 11 | (defun threat (i j a b) 12 | (or (eql i a) ;Same row 13 | (eql j b) ;Same column 14 | (eql (- i j) (- a b)) ;One diag. 15 | (eql (+ i j) (+ a b)))) ;the other diagonal 16 | 17 | ; Is position (n,m) on the board safe for a queen ? 18 | (defun conflict (n m board) 19 | (cond ((null board) nil) 20 | ((threat n m (caar board) (cadar board)) t) 21 | (t (conflict n m (cdr board))))) 22 | 23 | 24 | ; Place queens on a board of size SIZE 25 | (defun queens (size) 26 | (prog (n m board soln) 27 | (setq soln 0) ;Solution # 28 | (setq board nil) 29 | (setq n 1) ;Try the first row 30 | loop-n 31 | (setq m 1) ;Column 1 32 | loop-m 33 | (cond ((conflict n m board) (go un-do-m))) ;Check for conflict 34 | (setq board (cons (list n m) board)) ; Add queen to board 35 | (cond ((> (setq n (1+ n)) size) ; Placed N queens ? 36 | (print-board (reverse board) (setq soln (1+ soln))))) ; Print it 37 | (go loop-n) ; Next row which column? 38 | un-do-n 39 | (cond ((null board) (return 'Done)) ; Tried all possibilities 40 | (t (setq m (cadar board)) ; No, Undo last queen placed 41 | (setq n (caar board)) 42 | (setq board (cdr board)))) 43 | 44 | un-do-m 45 | (cond ((> (setq m (1+ m)) size) ; Go try next column 46 | (go un-do-n)) 47 | (t (go loop-m))))) 48 | 49 | 50 | ;Print a board 51 | (defun print-board (board soln &aux size) 52 | (setq size (length board)) ;we can find our own size 53 | (format t "\t\tSolution ~s\n\n\t" soln) 54 | (print-header size 1) 55 | (print-board-aux board size) 56 | (terpri)) 57 | 58 | ; Put Column #'s on top 59 | (defun print-header (size n) 60 | (dotimes (i size) (format t "~s " (1+ i))) 61 | (terpri)) 62 | 63 | (defun print-board-aux (board size &aux (row 0)) 64 | (mapc #'(lambda (x) 65 | (format t "~s\t" (setq row (1+ row))) 66 | (print-board-row (cadr x) size)) 67 | board)) 68 | 69 | (defun print-board-row (column size) 70 | (dotimes (i size) (princ (if (eql column (1+ i)) "Q " ". "))) 71 | (terpri)) 72 | 73 | -------------------------------------------------------------------------------- /xlisponly/lsp/rational.lsp: -------------------------------------------------------------------------------- 1 | (in-package :xlisp) 2 | (export 'rationalize) 3 | (defun rationalize (val) ; hopefully readable conversion 4 | (unless (typep val 'flonum) 5 | (if (typep val 'rational) 6 | (return-from rationalize val) 7 | (error "~s is invalid type" val))) 8 | (let ((fraction (abs (rem val 1.0)))) 9 | (if (zerop fraction) 10 | (round val) 11 | (let ((limit (expt 10 (- (+ 7 (truncate (log fraction 10))) 12 | (max 0 (truncate (log (abs val) 10)))))) 13 | divisor) 14 | (cond ((>= limit 10000) ; allow primes 3 3 7 11 13 15 | (setq limit (* 9009 (/ limit 10000)))) 16 | ((>= limit 1000) ; allow primes 3 3 7 11 17 | (setq limit (* 693 (/ limit 1000)))) 18 | ((>= limit 100) ; allow primes 3 3 7 19 | (setq limit (* 63 (/ limit 100))))) 20 | (setq divisor (round (/ limit fraction))) 21 | (if (floatp divisor) 22 | (round val) ; Doesn't fit 23 | (/ (round (* val divisor)) divisor)))))) 24 | -------------------------------------------------------------------------------- /xlisponly/lsp/readme.lsp: -------------------------------------------------------------------------------- 1 | Brief description of included Lisp source files and related documentation: 2 | 3 | Utilities: 4 | backquot.lsp Adds working nested backquotes 5 | classes.lsp* Useful functions for OOP 6 | common.lsp* More Common Lisp compatible functions. 7 | common2.lsp Still more Common Lisp compatible functions. 8 | edit.lsp Access external editor on .lsp files 9 | evalenv.lsp EVAL in current lexical context 10 | glos.lsp Glossary function 11 | glos.txt data file for glossary function 12 | infix.lsp Read macros for Infix to prefix converter (Winston and Horn) 13 | init.lsp* Default initialization file 14 | inspect.lsp Structure Editor (new version) 15 | matrix.lsp Poor implementation of multidimensional arrays 16 | pp.lsp* Pretty printer 17 | rational.lsp An attempt at implementing "rationalize" 18 | readme.lsp This file 19 | repair.lsp* Structure Editor 20 | sendmacr.lsp Read macros for "send" function 21 | step.lsp* Simple single-step utility 22 | stepper.lsp More advanced single-step utility 23 | stepper.doc Documentation for stepper.lsp 24 | turtle.lsp Turtle graphics primitives, from PC-LISP 25 | 26 | * Functions documented in manual 27 | 28 | Examples: 29 | ackerman.lsp Ackerman's function 30 | akalah.lsp "Kalah" (stones&pits) game 31 | akavect.lsp (same as akalah.lsp, but uses arrays rather than lists) 32 | art.lsp Simple OOP example 33 | blocks.lsp Winston & Horn's "Blocks world". Uses classes.lsp. 34 | change.lsp Change maker 35 | dragon.lsp Dragon curve, originally from PC-Lisp. Uses turtle.lsp 36 | example.lsp Simple OOP example 37 | fact.lsp Factorial function 38 | fib.lsp Fibinocci function (sorry for spelling) 39 | gblocks.lsp blocks.lsp, with graphic display 40 | hanoi.lsp Tower of hannoi puzzle 41 | hdwr.lsp OOP example of hardware simulation 42 | ifthen.lsp Mini expert system from Winston & Horn 43 | match.lsp Pattern matcher from Winston & Horn 44 | prolog.lsp Tiny Prolog interpreter 45 | qa.lsp Question Answering program 46 | queens.lsp Queens puzzle 47 | queens2.lsp Queens puzzle -- semi-graphical 48 | search.lsp Searching functions from Winston & Horn 49 | sort.lsp Sorting routines 50 | tak.lsp I have no idea. Some non-trivial recursive function. 51 | tconc.lsp tconc implementation 52 | turtles.lsp OOP turtle graphics example. 53 | wildcard.lsp Wildcard pattern matcher 54 | -------------------------------------------------------------------------------- /xlisponly/lsp/sendmacr.lsp: -------------------------------------------------------------------------------- 1 | (setf (aref *readtable* (char-int #\[)) 2 | (cons :tmacro 3 | (lambda (f c &aux ex) 4 | (do () 5 | ((eq (peek-char t f) #\])) 6 | (setf ex (append ex (list (read f))))) 7 | (read-char f) 8 | (cons (cons 'send ex) nil)))) 9 | 10 | (setf (aref *readtable* (char-int #\])) 11 | (cons :tmacro 12 | (lambda (f c) 13 | (error "misplaced right bracket")))) 14 | 15 | 16 | -------------------------------------------------------------------------------- /xlisponly/lsp/sort.lsp: -------------------------------------------------------------------------------- 1 | ;; Sort routines. 2 | ;; by Tom Almy 3 | 4 | 5 | ;; The built in sort does a quick sort which does a bad job if the list is 6 | ;; already sorted. INSERT is a destructive insertion into a sorted list. 7 | ;; Also, these are iterative and will handle lists of any size. SORT can 8 | ;; cause eval stack overflows on big lists. 9 | ;; In these functions, "function" is a predicate that orders the list 10 | ;; (For numbers, typically #'< ). 11 | (defun insert (element list function) 12 | (cond ((null list) (list element)) 13 | ((funcall function element (first list)) 14 | (cons element list)) 15 | (t (do ((prev list (rest prev))) 16 | ((or (endp (rest prev)) 17 | (funcall function element (second prev))) 18 | (rplacd prev (cons element (rest prev))) 19 | list))))) 20 | 21 | ;; And this inserts a list of items into an existing list (which can be nil) 22 | 23 | (defun insertall (elements list function) 24 | (dolist (element elements list) 25 | (setq list (insert element list function)))) 26 | 27 | 28 | ;; Once the list has been sorted, accessing is faster if the list is 29 | ;; placed in an array, and a binary search is performed. 30 | ;; The advantage starts at about 250 elements 31 | 32 | (defun memarray (element array &key (test #'eql) (function #'<)) 33 | (let* ((max (1- (length array))) 34 | (min 0) 35 | (index (/ (+ max min) 2))) 36 | (loop (when (funcall test element (aref array index)) 37 | (return index)) 38 | (if (funcall function element (aref array index)) 39 | (setq max (1- index)) 40 | (setq min (1+ index))) 41 | (when (> min max) (return nil)) 42 | (setq index (/ (+ max min) 2))))) 43 | 44 | 45 | -------------------------------------------------------------------------------- /xlisponly/lsp/tak.lsp: -------------------------------------------------------------------------------- 1 | (defun tak (x y z) 2 | (if (not (< y x)) 3 | z 4 | (tak (tak (1- x) y z) 5 | (tak (1- y) z x) 6 | (tak (1- z) x y)))) 7 | 8 | (defun dotak () 9 | (tak 18 12 6)) 10 | -------------------------------------------------------------------------------- /xlisponly/lsp/tconc.lsp: -------------------------------------------------------------------------------- 1 | ;; Not part of Common Lisp, but used in XLISP internally for string streams 2 | 3 | ;; THE CAR OF A TCONC POINTS TO THE TCONC LIST, 4 | ;; THE TAIL POINTS TO LAST ELEMENT 5 | 6 | (defun make-tconc nil 7 | (cons 'nil 'nil)) 8 | 9 | (defun tconc (tc new) 10 | (let ((newl (cons new 'nil))) 11 | (if (null (cdr tc)) 12 | (rplaca tc newl) 13 | (rplacd (cdr tc) newl)) 14 | (rplacd tc newl) 15 | tc)) 16 | 17 | (defun lconc (tc list) 18 | (cond ((not (null list)) 19 | (if (null (cdr tc)) 20 | (rplaca tc list) 21 | (rplacd (cdr tc) list)) 22 | (rplacd tc (last list)))) 23 | tc) 24 | 25 | (defun remove-head (tc) 26 | (cond ((null (car tc)) 'nil) 27 | ((null (cdar tc)) 28 | (let ((element (caar tc))) 29 | (rplaca tc 'nil) 30 | (rplacd tc 'nil) 31 | element)) 32 | (t (let ((element (caar tc))) 33 | (rplaca tc (cdar tc)) 34 | element)))) 35 | -------------------------------------------------------------------------------- /xlisponly/lsp/wildcard.lsp: -------------------------------------------------------------------------------- 1 | ; Wildcard Pattern matching algorithm 2 | ; * matches any substring (zero or more characters) 3 | ; ? matches any character 4 | ; ~c matches c 5 | 6 | (defun match (pattern list) 7 | (labels ((match1 (pattern suspect) 8 | (cond ((null pattern) (null suspect)) 9 | ((null suspect) (equal pattern '(:mult))) 10 | ((eq (first pattern) :single) 11 | (match1 (cdr pattern) (cdr suspect))) 12 | ((eq (first pattern) :mult) 13 | (if (null (rest pattern)) 14 | t 15 | (do ((p (rest pattern)) 16 | (l suspect (cdr l))) 17 | ((or (null l) (match1 p l)) 18 | (not (null l)))))) 19 | ((eq (first pattern) (first suspect)) 20 | (match1 (rest pattern) (rest suspect))) 21 | (t nil))) 22 | (explode (list) 23 | (cond ((null list) nil) 24 | ((eq (first list) #\*) 25 | (cons :mult (explode (rest list)))) 26 | ((eq (first list) #\?) 27 | (cons :single (explode (rest list)))) 28 | ((eq (first list) #\~) 29 | (cons (second list) 30 | (explode (rest (rest list))))) 31 | (t (cons (first list) (explode (rest list))))))) 32 | (let ((pat (explode (coerce pattern 'cons)))) 33 | (mapcan #'(lambda (x) (when (match1 pat (coerce x 'cons)) 34 | (list x))) 35 | list)))) 36 | 37 | (setq l (sort (apply #'nconc (map 'cons 38 | #'(lambda (x) (mapcar #'string x)) 39 | *obarray*)) 40 | #'string<)) 41 | -------------------------------------------------------------------------------- /xlisponly/sources/Makefile.in: -------------------------------------------------------------------------------- 1 | UCFLAGS = @UCFLAGS@ 2 | ULDFLAGS = @ULDFLAGS@ 3 | EXTRALIBS = @EXTRALIBS@ 4 | EXTRAOBJS = @EXTRAOBJS@ 5 | CC = @CC@ 6 | 7 | CFLAGS = -DXLISP_ONLY $(UCFLAGS) 8 | 9 | SRCDIR=../.. 10 | 11 | SRC=xlisp.c xlbfun.c xlbignum.c xlcont.c xldbug.c xldmem.c xleval.c \ 12 | xlfio.c xlglob.c xlimage.c xlinit.c xlio.c xljump.c xllist.c \ 13 | xlobj.c xlpp.c xlprin.c xlread.c xlstr.c xlsubr.c \ 14 | xlsym.c xlsys.c unixprim.c unixstuff.c xlseq.c xlstruct.c xlftab.c xlmath2.c \ 15 | xlmath3.c xlarray.c xlrand.c xltvec.c xlbcode.c xlbcutil.c xlshlib.c \ 16 | xlwrap.c xlmodule.c dummy.c 17 | 18 | INC=osdefs.h xlbcode.h xlftab.h xlisp.h osptrs.h xldmem.h xlglob.h xlmodule.h \ 19 | version.h xlshlib.h xlwrap.h 20 | 21 | OBJ=xlisp.o xlbfun.o xlbignum.o xlcont.o xldbug.o xldmem.o xleval.o \ 22 | xlfio.o xlglob.o xlimage.o xlinit.o xlio.o xljump.o xllist.o \ 23 | xlobj.o xlpp.o xlprin.o xlread.o xlstr.o xlsubr.o \ 24 | xlsym.o xlsys.o unixprim.o unixstuff.o xlseq.o xlstruct.o xlftab.o xlmath2.o \ 25 | xlmath3.o xlarray.o xlrand.o xltvec.o xlbcode.o xlbcutil.o xlshlib.o \ 26 | xlwrap.o xlmodule.o dummy.o 27 | 28 | OTHER=configure configure.in config machines shlibconfig.sh.in xlconfig.h.in \ 29 | Extras 30 | 31 | xlisp.bin: $(OBJ) $(EXTRAOBJS) 32 | $(CC) -o xlisp.bin $(ULDFLAGS) $(OBJ) $(EXTRAOBJS) $(EXTRALIBS) -lm 33 | -ln -s xlisp.bin xlisp 34 | 35 | xlisp.wks: xlisp.bin cmpload.lsp 36 | rm -f xlisp.wks 37 | (echo '(save "xlisp.wks") (exit)') | ./xlisp.bin cmpload 38 | 39 | 40 | $(OBJ): xlisp.h $(INC) 41 | 42 | 43 | # this is used if compiling in a subdirectory of the xlispstat tree 44 | $(SRC) $(INC): 45 | ln -s $(SRCDIR)/$@ $@ 46 | 47 | 48 | # this is used for creating the separate xlisp only distribution 49 | srcfiles: 50 | (cd $(SRCDIR); tar cf - $(SRC) $(INC) $(OTHER)) | tar xf - 51 | 52 | 53 | clean: 54 | rm -f *.o Make.log 55 | 56 | 57 | cleanall: clean 58 | rm -f xlisp.bin 59 | -------------------------------------------------------------------------------- /xlisponly/sources/cmpload.lsp: -------------------------------------------------------------------------------- 1 | ;(expand 20) 2 | 3 | (load "../cmplsp/common") 4 | (load "../cmplsp/common2") 5 | (load "../cmplsp/common3") 6 | (load "../cmplsp/pathname") 7 | (load "../cmplsp/loadfsl") 8 | (load "../cmplsp/conditns") 9 | (load "../cmplsp/shlib") 10 | 11 | (push :packages *features*) 12 | (push :times *features*) 13 | (push :posfcns *features*) 14 | (push :math *features*) 15 | (push :mulvals *features*) 16 | (push :bignums *features*) 17 | 18 | (xlisp::use-conditions) 19 | 20 | (defpackage "XLSCMP" 21 | (:use "XLISP") 22 | (:import-from "XLISP" "*CMP-SETF*" "*CMP-STRUCTS*" "*CMP-GLOBAL-MACROS*" 23 | "*CMP-MACROS*" "*CMP-SPECIALS*")) 24 | 25 | (setf xlisp::*default-path* nil) 26 | 27 | (cond 28 | ((probe-file "cmpfront.fsl") (load "cmpfront")) 29 | (t (load "../compiler/backquot") 30 | (load "../compiler/cmpmacro") 31 | (load "../compiler/convert") 32 | (load "../compiler/cells") 33 | (load "../compiler/simplify") 34 | (load "../compiler/lift") 35 | (load "../compiler/gencode") 36 | (load "../compiler/peephole") 37 | (load "../compiler/assemble") 38 | (load "../compiler/cmpfront"))) 39 | 40 | (in-package "XLISP") 41 | 42 | (export '(compiler-let define-setf-method define-modify-macro locally)) 43 | (export '(save restore)) 44 | (export 'variable) 45 | 46 | (defun initialize-system () 47 | (setf *load-pathname-defaults* 48 | (list *default-path* 49 | (merge-pathnames (make-pathname :directory 50 | '(:relative "Autoload")) 51 | *default-path*))) 52 | 53 | ;; load autoload information 54 | (setf *condition-hook* 'condition-hook) 55 | (mapc #'register-autoloads (create-autoload-path)) 56 | 57 | ;; initialize module search path 58 | (setf *module-path* (create-module-path))) 59 | 60 | (setf *startup-functions* '(use-conditions initialize-system)) 61 | -------------------------------------------------------------------------------- /xlisponly/xlisp.sh: -------------------------------------------------------------------------------- 1 | XLISPLIB=LIBDIR export XLISPLIB 2 | if test -f xlisp.wks; then WKS="xlisp.wks"; 3 | else WKS="${XLISPLIB}/xlisp.wks"; 4 | fi 5 | if test -f xlisp.bin; then XLISP=xlisp.bin; 6 | else XLISP="${XLISPLIB}/xlisp.bin" 7 | fi 8 | exec ${XLISP} -w${WKS} $* 9 | --------------------------------------------------------------------------------