├── .gitattributes ├── .github └── workflows │ ├── build-linux.yml │ └── lisp-kernel.yml ├── .gitignore ├── LICENSE ├── README.md ├── cocoa-ide ├── Info.plist-proto ├── README ├── altconsole │ ├── AltConsole-Info.plist │ ├── AltConsoleDocument.h │ ├── AltConsoleDocument.m │ ├── AltConsoleDocumentController.h │ ├── AltConsoleDocumentController.m │ ├── Makefile │ ├── main.m │ ├── resource │ │ ├── AltConsole.nib │ │ │ ├── classes.nib │ │ │ ├── info.nib │ │ │ └── keyedobjects.nib │ │ ├── Clear.tiff │ │ ├── Credits.rtf │ │ ├── InfoPlist.strings │ │ └── MainMenu.nib │ │ │ ├── classes.nib │ │ │ ├── info.nib │ │ │ ├── keyedobjects.nib │ │ │ └── objects.nib │ └── version.plist ├── app-delegate.lisp ├── apropos-window.lisp ├── asdf-browser.lisp ├── build-application.lisp ├── builder-utilities.lisp ├── ccl-ide.lisp ├── cocoa-application.lisp ├── cocoa-backtrace.lisp ├── cocoa-defaults.lisp ├── cocoa-doc.lisp ├── cocoa-editor.lisp ├── cocoa-grep-pre-lion.lisp ├── cocoa-grep.lisp ├── cocoa-listener.lisp ├── cocoa-remote-lisp.lisp ├── cocoa-typeout.lisp ├── cocoa-utils.lisp ├── cocoa-window.lisp ├── cocoa.lisp ├── compile-hemlock.lisp ├── console-log.lisp ├── console-window.lisp ├── constants.lisp ├── defsystem.lisp ├── file-dialogs.lisp ├── hemlock-commands.lisp ├── hemlock-text.lisp ├── hemlock.lisp ├── hemlock │ ├── INSTALL │ ├── README │ ├── TODO │ ├── doc │ │ ├── cim │ │ │ ├── aux-sys.mss │ │ │ └── cim.mss │ │ ├── misc │ │ │ ├── compilation.order │ │ │ ├── hemlock.log │ │ │ ├── hemlock.upd │ │ │ ├── notes.txt │ │ │ ├── perq-hemlock.log │ │ │ └── things-to-do.txt │ │ ├── scribe-converter │ │ │ ├── NOTES │ │ │ └── README │ │ └── user │ │ │ ├── commands.mss │ │ │ ├── intro.mss │ │ │ ├── lisp.mss │ │ │ ├── mail.mss │ │ │ ├── netnews.mss │ │ │ ├── special-modes.mss │ │ │ └── user.mss │ ├── hemlock.system │ ├── hemlock11.cursor │ ├── hemlock11.mask │ ├── maint │ │ └── publish │ ├── resources │ │ ├── XKeysymDB │ │ ├── mh-scan │ │ └── spell-dictionary.text │ ├── src │ │ ├── bindings.lisp │ │ ├── buffer.lisp │ │ ├── charmacs.lisp │ │ ├── charprops.lisp │ │ ├── cocoa-hemlock.lisp │ │ ├── command.lisp │ │ ├── comments.lisp │ │ ├── completion.lisp │ │ ├── decls.lisp │ │ ├── defsyn.lisp │ │ ├── display.lisp │ │ ├── doccoms.lisp │ │ ├── echo.lisp │ │ ├── echocoms.lisp │ │ ├── edit-defs.lisp │ │ ├── filecoms.lisp │ │ ├── files.lisp │ │ ├── fill.lisp │ │ ├── font.lisp │ │ ├── hemlock-ext.lisp │ │ ├── htext1.lisp │ │ ├── htext2.lisp │ │ ├── htext3.lisp │ │ ├── htext4.lisp │ │ ├── indent.lisp │ │ ├── interp.lisp │ │ ├── isearchcoms.lisp │ │ ├── key-event.lisp │ │ ├── keysym-defs.lisp │ │ ├── killcoms.lisp │ │ ├── line.lisp │ │ ├── lispmode.lisp │ │ ├── listener.lisp │ │ ├── macros.lisp │ │ ├── main.lisp │ │ ├── modeline.lisp │ │ ├── morecoms.lisp │ │ ├── package.lisp │ │ ├── pop-up-stream.lisp │ │ ├── register.lisp │ │ ├── ring.lisp │ │ ├── rompsite.lisp │ │ ├── search1.lisp │ │ ├── search2.lisp │ │ ├── searchcoms.lisp │ │ ├── streams.lisp │ │ ├── struct.lisp │ │ ├── symbol-completion.lisp │ │ ├── syntax.lisp │ │ ├── table.lisp │ │ ├── text.lisp │ │ ├── undo.lisp │ │ ├── vars.lisp │ │ └── views.lisp │ ├── unused │ │ ├── archive │ │ │ ├── abbrev.lisp │ │ │ ├── auto-save.lisp │ │ │ ├── bit-display.lisp │ │ │ ├── bit-screen.lisp │ │ │ ├── bufed.lisp │ │ │ ├── debug.lisp │ │ │ ├── dired.lisp │ │ │ ├── diredcoms.lisp │ │ │ ├── display.lisp │ │ │ ├── dylan.lisp │ │ │ ├── elisp │ │ │ │ ├── README │ │ │ │ ├── base.lisp │ │ │ │ ├── cmucl-hemlock-glue.lisp │ │ │ │ ├── codewalker.lisp │ │ │ │ ├── compile.lisp │ │ │ │ ├── hemlock-shims.lisp │ │ │ │ ├── implementation-needed │ │ │ │ ├── internals.lisp │ │ │ │ ├── loadup.lisp │ │ │ │ ├── packages.lisp │ │ │ │ └── read-table.lisp │ │ │ ├── eval-server.lisp │ │ │ ├── group.lisp │ │ │ ├── highlight.lisp │ │ │ ├── hunk-draw.lisp │ │ │ ├── input.lisp │ │ │ ├── lisp-lib.lisp │ │ │ ├── lispbuf.lisp │ │ │ ├── lispeval.lisp │ │ │ ├── mh.lisp │ │ │ ├── netnews.lisp │ │ │ ├── overwrite.lisp │ │ │ ├── pascal.lisp │ │ │ ├── rcs.lisp │ │ │ ├── screen.lisp │ │ │ ├── scribe.lisp │ │ │ ├── shell.lisp │ │ │ ├── spell-aug.lisp │ │ │ ├── spell-corr.lisp │ │ │ ├── spell-rt.lisp │ │ │ ├── spell │ │ │ │ ├── README │ │ │ │ ├── build.lisp │ │ │ │ ├── classes.lisp │ │ │ │ ├── constants.lisp │ │ │ │ ├── correlate.lisp │ │ │ │ ├── flags.lisp │ │ │ │ ├── hashing.lisp │ │ │ │ ├── io.lisp │ │ │ │ ├── package.lisp │ │ │ │ ├── spell-aug.lisp │ │ │ │ ├── spell-dictionary.text │ │ │ │ ├── spell.asd │ │ │ │ └── spellcoms.lisp │ │ │ ├── spellcoms.lisp │ │ │ ├── srccom.lisp │ │ │ ├── ts-buf.lisp │ │ │ ├── ts-stream.lisp │ │ │ ├── tty │ │ │ │ ├── termcap.lisp │ │ │ │ ├── tty-disp-rt.lisp │ │ │ │ ├── tty-display.lisp │ │ │ │ └── tty-screen.lisp │ │ │ ├── unixcoms.lisp │ │ │ ├── window.lisp │ │ │ ├── winimage.lisp │ │ │ ├── wire │ │ │ │ ├── Notes │ │ │ │ ├── package.lisp │ │ │ │ ├── port.lisp │ │ │ │ ├── remote.lisp │ │ │ │ └── wire.lisp │ │ │ └── xcoms.lisp │ │ ├── bit-stream.lisp │ │ ├── clx-ext.lisp │ │ ├── cursor.lisp │ │ ├── ed-integrity.lisp │ │ ├── gosmacs.lisp │ │ ├── hacks.lisp │ │ ├── hemcom.lisp │ │ ├── hi-integrity.lisp │ │ ├── icom.lisp │ │ ├── kbdmac.lisp │ │ ├── keytran.lisp │ │ ├── keytrandefs.lisp │ │ ├── linimage.lisp │ │ ├── spell-build.lisp │ │ ├── struct-ed.lisp │ │ └── tty-stream.lisp │ └── website │ │ └── index.html.in ├── ide-application.lisp ├── ide-bundle.lisp ├── ide-contents │ ├── PkgInfo │ └── Resources │ │ ├── Appearance.tiff │ │ ├── Documentation.icns │ │ ├── Encodings.tiff │ │ ├── English.lproj │ │ ├── Authenticate.nib │ │ │ ├── designable.nib │ │ │ └── keyedobjects.nib │ │ ├── Credits.html │ │ ├── OpenmclInspector.nib │ │ │ ├── classes.nib │ │ │ ├── info.nib │ │ │ └── keyedobjects.nib │ │ ├── ProgressWindow.nib │ │ │ ├── designable.nib │ │ │ └── keyedobjects.nib │ │ ├── SearchFiles.nib │ │ │ ├── designable.nib │ │ │ └── keyedobjects.nib │ │ ├── SearchFilesPreLion.nib │ │ │ ├── classes.nib │ │ │ ├── info.nib │ │ │ └── keyedobjects.nib │ │ ├── apropos.nib │ │ │ ├── classes.nib │ │ │ ├── info.nib │ │ │ └── keyedobjects.nib │ │ ├── backtrace.nib │ │ │ ├── designable.nib │ │ │ └── keyedobjects.nib │ │ ├── displaydoc.nib │ │ │ ├── classes.nib │ │ │ ├── info.nib │ │ │ └── keyedobjects.nib │ │ ├── inspector.nib │ │ │ ├── designable.nib │ │ │ └── keyedobjects.nib │ │ ├── processes.nib │ │ │ ├── classes.nib │ │ │ ├── info.nib │ │ │ └── keyedobjects.nib │ │ ├── project.nib │ │ │ ├── designable.nib │ │ │ └── keyedobjects.nib │ │ ├── updateCCL.nib │ │ │ ├── designable.nib │ │ │ └── keyedobjects.nib │ │ ├── xapropos.nib │ │ │ ├── classes.nib │ │ │ ├── info.nib │ │ │ └── keyedobjects.nib │ │ └── xinspector.nib │ │ │ ├── designable.nib │ │ │ └── keyedobjects.nib │ │ ├── General.tiff │ │ ├── Help │ │ ├── cocoa-notes.html │ │ └── index.html │ │ ├── collapse-all.png │ │ ├── expand-all.png │ │ ├── font-panel.tiff │ │ ├── gear.png │ │ ├── info.tiff │ │ ├── openmcl-icon.icns │ │ └── openmcl-icon.ico ├── ide-self-update.lisp ├── inspector.lisp ├── menus.lisp ├── preferences-views.lisp ├── preferences.lisp ├── processes-window.lisp ├── search-files-pre-lion.lisp ├── search-files.lisp ├── start.lisp ├── xapropos.lisp └── xinspector.lisp ├── compiler ├── ARM │ ├── arm-arch.lisp │ ├── arm-asm.lisp │ ├── arm-backend.lisp │ ├── arm-disassemble.lisp │ ├── arm-lap.lisp │ ├── arm-lapmacros.lisp │ ├── arm-vinsns.lisp │ └── arm2.lisp ├── ARM64 │ ├── arm64-arch.lisp │ └── arm64-asm.lisp ├── PPC │ ├── PPC32 │ │ ├── ppc32-arch.lisp │ │ ├── ppc32-backend.lisp │ │ └── ppc32-vinsns.lisp │ ├── PPC64 │ │ ├── ppc64-arch.lisp │ │ ├── ppc64-backend.lisp │ │ └── ppc64-vinsns.lisp │ ├── ppc-arch.lisp │ ├── ppc-asm.lisp │ ├── ppc-backend.lisp │ ├── ppc-disassemble.lisp │ ├── ppc-lap.lisp │ ├── ppc-lapmacros.lisp │ └── ppc2.lisp ├── X86 │ ├── X8632 │ │ ├── x8632-arch.lisp │ │ ├── x8632-backend.lisp │ │ └── x8632-vinsns.lisp │ ├── X8664 │ │ ├── x8664-arch.lisp │ │ ├── x8664-backend.lisp │ │ └── x8664-vinsns.lisp │ ├── x86-arch.lisp │ ├── x86-asm.lisp │ ├── x86-backend.lisp │ ├── x86-disassemble.lisp │ ├── x86-lap.lisp │ ├── x86-lapmacros.lisp │ └── x862.lisp ├── acode-rewrite.lisp ├── arch.lisp ├── backend.lisp ├── dll-node.lisp ├── lambda-list.lisp ├── nx-base-app.lisp ├── nx-basic.lisp ├── nx.lisp ├── nx0.lisp ├── nx1.lisp ├── nx2.lisp ├── nxenv.lisp ├── optimizers.lisp ├── reg.lisp ├── risc-lap.lisp ├── subprims.lisp ├── vinsn.lisp └── vreg.lisp ├── doc ├── README ├── compiler-changes-in-CCL-1.12-trunk.pdf ├── internals │ ├── .gitignore │ ├── Makefile │ ├── assembler.ccldoc │ ├── backend.ccldoc │ ├── glossary.ccldoc │ ├── implementation.ccldoc │ └── internals.ccldoc ├── manual │ ├── .gitignore │ ├── Makefile │ ├── about.ccldoc │ ├── build.ccldoc │ ├── ccl.ccldoc │ ├── debugging.ccldoc │ ├── external-process.ccldoc │ ├── ffi.ccldoc │ ├── fs.ccldoc │ ├── gc.ccldoc │ ├── glossary.ccldoc │ ├── hemlock.ccldoc │ ├── ide.ccldoc │ ├── install.ccldoc │ ├── limits.ccldoc │ ├── modifying.ccldoc │ ├── mop.ccldoc │ ├── objc-bridge.ccldoc │ ├── os.ccldoc │ ├── platform-notes.ccldoc │ ├── profile.ccldoc │ ├── q-and-a.ccldoc │ ├── sockets.ccldoc │ ├── streams.ccldoc │ ├── style.css │ ├── threads.ccldoc │ ├── toplevel.ccldoc │ ├── unicode.ccldoc │ └── using.ccldoc ├── release-notes-1.1.txt ├── release-notes-1.2.txt └── release-notes.txt ├── examples ├── FFI │ ├── Allocating-foreign-data-on-the-lisp-heap │ │ ├── Readme.rtf │ │ ├── ptrtest-compile.sh │ │ ├── ptrtest.c │ │ └── ptrtest.lisp │ └── Using-basic-calls-and-types │ │ ├── Readme.rtf │ │ ├── typetest-compile.sh │ │ ├── typetest.c │ │ └── typetest.lisp ├── README-OPENMCL-EXAMPLES ├── android │ └── native-activity.lisp ├── cocoa-inspector.lisp ├── cocoa │ ├── easygui.lisp │ ├── easygui │ │ ├── action-targets.lisp │ │ ├── dialogs.lisp │ │ ├── events.lisp │ │ ├── example │ │ │ ├── currency-converter.lisp │ │ │ ├── tiny.lisp │ │ │ └── view-hierarchy.lisp │ │ ├── new-cocoa-bindings.lisp │ │ ├── package.lisp │ │ ├── rgb.lisp │ │ ├── system.lisp │ │ └── views.lisp │ ├── interface-databases │ │ ├── HOWTO.html │ │ └── HOWTO_files │ │ │ ├── images │ │ │ └── bosco.jpg │ │ │ └── stylesheets │ │ │ └── styles.css │ ├── progress-view-controller │ │ └── progress-view-controller.lisp │ ├── qtvidcapture │ │ ├── QTVidCapture.nib │ │ │ ├── classes.nib │ │ │ ├── info.nib │ │ │ └── keyedobjects.nib │ │ └── qtvidcapture.lisp │ ├── tiny.lisp │ └── ui-elements │ │ ├── HOWTO.html │ │ └── HOWTO_files │ │ ├── images │ │ └── bosco.jpg │ │ └── stylesheets │ │ └── styles.css ├── code-cover-test │ ├── README.txt │ ├── cl-ppcre-tests.lisp │ ├── code-cover-test-server.asd │ ├── code-cover-test-server.lisp │ ├── code-cover-test.asd │ ├── code-cover-test.lisp │ ├── compile-with-code-coverage.lisp │ └── package.lisp ├── gtk-minesweeper.lisp ├── gtk2-clock.lisp ├── jfli │ ├── CPL.TXT │ ├── com │ │ └── richhickey │ │ │ └── jfli │ │ │ └── LispInvocationHandler.java │ ├── docs │ │ ├── bullet.gif │ │ ├── bullet2.gif │ │ ├── jfli.css │ │ ├── jfli.html │ │ ├── jfli_bkgrnd.gif │ │ └── jfli_new.gif │ ├── examples │ │ ├── session.lisp │ │ └── swtdemo.lisp │ ├── jfli-lw.lisp │ ├── jfli.jar │ ├── jfli.lisp │ └── jni-lw.lisp ├── mswin.lisp ├── opengl-ffi.lisp ├── rubix │ ├── blocks.lisp │ ├── lights.lisp │ ├── loader.lisp │ ├── opengl.lisp │ ├── rubix.lisp │ └── vectors.lisp ├── sockets │ └── socket-test.lisp └── webkit.lisp ├── level-0 ├── ARM │ ├── arm-array.lisp │ ├── arm-bignum.lisp │ ├── arm-clos.lisp │ ├── arm-def.lisp │ ├── arm-float.lisp │ ├── arm-hash.lisp │ ├── arm-io.lisp │ ├── arm-misc.lisp │ ├── arm-numbers.lisp │ ├── arm-pred.lisp │ ├── arm-symbol.lisp │ └── arm-utils.lisp ├── PPC │ ├── PPC32 │ │ └── ppc32-bignum.lisp │ ├── PPC64 │ │ └── ppc64-bignum.lisp │ ├── ppc-array.lisp │ ├── ppc-clos.lisp │ ├── ppc-def.lisp │ ├── ppc-float.lisp │ ├── ppc-hash.lisp │ ├── ppc-io.lisp │ ├── ppc-misc.lisp │ ├── ppc-numbers.lisp │ ├── ppc-pred.lisp │ ├── ppc-symbol.lisp │ └── ppc-utils.lisp ├── X86 │ ├── X8632 │ │ ├── x8632-array.lisp │ │ ├── x8632-bignum.lisp │ │ ├── x8632-clos.lisp │ │ ├── x8632-def.lisp │ │ ├── x8632-float.lisp │ │ ├── x8632-hash.lisp │ │ ├── x8632-misc.lisp │ │ ├── x8632-numbers.lisp │ │ ├── x8632-pred.lisp │ │ ├── x8632-symbol.lisp │ │ └── x8632-utils.lisp │ ├── X8664 │ │ └── x8664-bignum.lisp │ ├── x86-array.lisp │ ├── x86-clos.lisp │ ├── x86-def.lisp │ ├── x86-float.lisp │ ├── x86-hash.lisp │ ├── x86-io.lisp │ ├── x86-misc.lisp │ ├── x86-numbers.lisp │ ├── x86-pred.lisp │ ├── x86-symbol.lisp │ └── x86-utils.lisp ├── l0-aprims.lisp ├── l0-array.lisp ├── l0-bignum32.lisp ├── l0-bignum64.lisp ├── l0-cfm-support.lisp ├── l0-complex.lisp ├── l0-def.lisp ├── l0-error.lisp ├── l0-float.lisp ├── l0-hash.lisp ├── l0-init.lisp ├── l0-int.lisp ├── l0-io.lisp ├── l0-misc.lisp ├── l0-numbers.lisp ├── l0-pred.lisp ├── l0-symbol.lisp ├── l0-utils.lisp └── nfasload.lisp ├── level-1 ├── arm-callback-support.lisp ├── arm-error-signal.lisp ├── arm-threads-utils.lisp ├── arm-trap-support.lisp ├── l1-application.lisp ├── l1-aprims.lisp ├── l1-boot-1.lisp ├── l1-boot-2.lisp ├── l1-boot-3.lisp ├── l1-boot-lds.lisp ├── l1-callbacks.lisp ├── l1-cl-package.lisp ├── l1-clos-boot.lisp ├── l1-clos.lisp ├── l1-dcode.lisp ├── l1-error-signal.lisp ├── l1-error-system.lisp ├── l1-events.lisp ├── l1-files.lisp ├── l1-format.lisp ├── l1-init.lisp ├── l1-io.lisp ├── l1-lisp-threads.lisp ├── l1-numbers.lisp ├── l1-pathnames.lisp ├── l1-processes.lisp ├── l1-reader.lisp ├── l1-readloop-lds.lisp ├── l1-readloop.lisp ├── l1-sockets.lisp ├── l1-sort.lisp ├── l1-streams.lisp ├── l1-symhash.lisp ├── l1-sysio.lisp ├── l1-typesys.lisp ├── l1-unicode.lisp ├── l1-utils.lisp ├── level-1.lisp ├── linux-files.lisp ├── ppc-callback-support.lisp ├── ppc-error-signal.lisp ├── ppc-threads-utils.lisp ├── ppc-trap-support.lisp ├── runtime.lisp ├── sysutils.lisp ├── version.lisp ├── x86-callback-support.lisp ├── x86-error-signal.lisp ├── x86-threads-utils.lisp └── x86-trap-support.lisp ├── lib ├── apropos.lisp ├── arglist.lisp ├── arm-backtrace.lisp ├── armenv.lisp ├── arrays-fry.lisp ├── backquote.lisp ├── backtrace-lds.lisp ├── backtrace.lisp ├── case-error.lisp ├── ccl-export-syms.lisp ├── chars.lisp ├── compile-ccl.lisp ├── db-io.lisp ├── defstruct-lds.lisp ├── defstruct-macros.lisp ├── defstruct.lisp ├── describe.lisp ├── distrib-inits.lisp ├── dumplisp.lisp ├── edit-callers.lisp ├── encapsulate.lisp ├── ffi-androidarm.lisp ├── ffi-darwinarm.lisp ├── ffi-darwinppc32.lisp ├── ffi-darwinppc64.lisp ├── ffi-darwinx8632.lisp ├── ffi-darwinx8664.lisp ├── ffi-freebsdx8632.lisp ├── ffi-freebsdx8664.lisp ├── ffi-linuxarm.lisp ├── ffi-linuxppc32.lisp ├── ffi-linuxppc64.lisp ├── ffi-linuxx8632.lisp ├── ffi-linuxx8664.lisp ├── ffi-solarisx8632.lisp ├── ffi-solarisx8664.lisp ├── ffi-win32.lisp ├── ffi-win64.lisp ├── foreign-types.lisp ├── format.lisp ├── hash.lisp ├── late-clos.lisp ├── level-2.lisp ├── lists.lisp ├── macros.lisp ├── mcl-compat.lisp ├── method-combination.lisp ├── misc.lisp ├── nfcomp.lisp ├── number-case-macro.lisp ├── number-macros.lisp ├── numbers.lisp ├── pathnames.lisp ├── ppc-backtrace.lisp ├── ppcenv.lisp ├── pprint.lisp ├── prepare-mcl-environment.lisp ├── print-db.lisp ├── read.lisp ├── sequences.lisp ├── setf-runtime.lisp ├── setf.lisp ├── sort.lisp ├── source-files.lisp ├── streams.lisp ├── swink.lisp ├── systems.lisp ├── time.lisp ├── x86-backtrace.lisp ├── x86-watch.lisp ├── x8632env.lisp ├── x8664env.lisp └── xref.lisp ├── library ├── chud-metering.lisp ├── chud-metering.txt ├── cn-encode.lisp ├── core-files.lisp ├── cover.lisp ├── dominance.lisp ├── elf.lisp ├── intel-io.lisp ├── jni.lisp ├── jp-encode.lisp ├── leaks.lisp ├── lisp-package.lisp ├── lispequ.lisp ├── loop.lisp ├── mac-file-io.lisp ├── mach-o-symbols.lisp ├── mach-o.lisp ├── macptr-termination.lisp ├── openmcl-gtk-support.lisp ├── oprofile.txt ├── parse-ffi.lisp ├── pascal-strings.lisp ├── prefixed-stream.lisp ├── pty.lisp ├── remote-lisp.lisp ├── sequence-utils.lisp ├── serial-streams.lisp ├── sharp-comma.lisp ├── sockets.lisp ├── splay-tree.lisp ├── swank-loader.lisp └── timestamped-stream.lisp ├── lisp-kernel ├── albt.c ├── androidarm │ ├── Makefile │ ├── aarmcl.c │ ├── android_native_app_glue.c │ ├── android_native_app_glue.h │ ├── armandroid.x │ ├── fixlib.c │ ├── link.h │ ├── linker.h │ └── ucontext.h ├── area.h ├── arm-asmutils.s ├── arm-constants.h ├── arm-constants.s ├── arm-exceptions.c ├── arm-exceptions.h ├── arm-gc.c ├── arm-macros.s ├── arm-spentry.s ├── arm-uuo.s ├── arm64-constants.h ├── arm64-constants.s ├── arm64-exceptions.h ├── arm64-macros.s ├── arm64-spentry.s ├── arm64-uuo.s ├── arm_print.c ├── bits.c ├── bits.h ├── constants.h ├── darwinarm │ └── Makefile ├── darwinx8632 │ ├── .gdbinit │ └── Makefile ├── darwinx8664 │ ├── .gdbinit │ ├── Makefile │ └── lldbinit ├── errors.s ├── freebsdx8632 │ ├── .gdbinit │ └── Makefile ├── freebsdx8664 │ ├── .gdbinit │ └── Makefile ├── gc-common.c ├── gc.h ├── image.c ├── image.h ├── imports.s ├── kernel-globals.h ├── linuxarm │ ├── .gdbinit │ ├── Makefile │ ├── armlinux.x │ └── float_abi.mk ├── linuxarm64 │ └── Makefile ├── linuxppc │ ├── .gdbinit │ ├── Makefile │ └── elf32ppclinux.x ├── linuxppc64 │ ├── Makefile │ └── elf64ppc.x ├── linuxx8632 │ ├── .gdbinit │ └── Makefile ├── linuxx8664 │ ├── .gdbinit │ ├── Makefile │ └── elf_x86_64.x ├── lisp-debug.c ├── lisp-errors.h ├── lisp-exceptions.h ├── lisp.h ├── lisp.s ├── lisp_globals.h ├── lisp_globals.s ├── lispdcmd.c ├── lispdcmd.h ├── lisptypes.h ├── m4macros.m4 ├── mach-o-image.c ├── mach_exc.defs ├── macros.h ├── memory.c ├── memprotect.h ├── os-darwin.h ├── os-freebsd.h ├── os-linux.h ├── os-solaris.h ├── os-windows.h ├── pad.s ├── platform-androidarm.h ├── platform-darwinarm.h ├── platform-darwinx8632.h ├── platform-darwinx8664.h ├── platform-freebsdx8632.h ├── platform-freebsdx8664.h ├── platform-linuxarm.h ├── platform-linuxppc.h ├── platform-linuxppc64.h ├── platform-linuxx8632.h ├── platform-linuxx8664.h ├── platform-solarisx64.h ├── platform-solarisx86.h ├── platform-win32.h ├── platform-win64.h ├── plbt.c ├── plprint.c ├── plsym.c ├── pmcl-kernel.c ├── ppc-asmutils.s ├── ppc-constants.h ├── ppc-constants.s ├── ppc-constants32.h ├── ppc-constants32.s ├── ppc-constants64.h ├── ppc-constants64.s ├── ppc-exceptions.c ├── ppc-exceptions.h ├── ppc-gc.c ├── ppc-macros.s ├── ppc-spentry.s ├── ppc-spjump.s ├── ppc-subprims.s ├── ppc-uuo.s ├── ppc_print.c ├── probes.d ├── solarisx64 │ ├── .gdbinit │ └── Makefile ├── solarisx86 │ └── Makefile ├── static-linuxppc │ ├── Makefile │ ├── ccl-platform.h │ └── staticlib.c ├── thread_manager.c ├── threads.h ├── unix-calls.c ├── win32 │ ├── .gdbinit │ ├── Makefile │ └── win32-foreign-thread-support.c ├── win64 │ ├── .gdbinit │ ├── Makefile │ ├── Makefile.nmake │ ├── pei-x86-64.x │ └── yasm-redefinition.patch ├── windows-calls.c ├── x86-asmutils32.s ├── x86-asmutils64.s ├── x86-constants.h ├── x86-constants.s ├── x86-constants32.h ├── x86-constants32.s ├── x86-constants64.h ├── x86-constants64.s ├── x86-exceptions.c ├── x86-exceptions.h ├── x86-gc.c ├── x86-macros.s ├── x86-spentry32.s ├── x86-spentry64.s ├── x86-spjump32.s ├── x86-spjump64.s ├── x86-subprims32.s ├── x86-subprims64.s ├── x86-utils.c ├── x86-utils.h ├── x86-uuo.s ├── x86_print.c └── xlbt.c ├── mac-ui ├── ccl-application.lisp ├── cf-utils.lisp ├── cg.lisp ├── event-process.lisp ├── libdispatch.lisp ├── objc-wrapper.lisp └── package.lisp ├── objc-bridge ├── bridge.lisp ├── name-translation.lisp ├── objc-clos.lisp ├── objc-package.lisp ├── objc-readtable.lisp ├── objc-runtime.lisp ├── objc-support.lisp └── obsolete │ ├── CocoaBridgeDoc.txt │ └── README ├── scripts ├── ccl ├── ccl64 ├── get-binaries ├── get-bootstrap-binaries.py ├── http-to-ssh ├── http-to-svn ├── make-standalone-app ├── make-store-app ├── makedmg └── svn-switch ├── tools ├── README.txt ├── advice-profiler │ ├── overhead.lisp │ ├── package.lisp │ ├── profiler.asd │ └── profiler.lisp ├── asdf.lisp └── defsystem.lisp └── xdump ├── faslenv.lisp ├── hashenv.lisp ├── heap-image.lisp ├── xarmfasload.lisp ├── xfasload.lisp ├── xppcfasload.lisp ├── xx8632-fasload.lisp └── xx8664-fasload.lisp /.github/workflows/build-linux.yml: -------------------------------------------------------------------------------- 1 | name: Build and test 2 | 3 | on: 4 | workflow_dispatch: 5 | pull_request: 6 | 7 | env: 8 | URL: https://github.com/Clozure/ccl/releases/latest/download/linuxx86.tar.gz 9 | 10 | jobs: 11 | linux: 12 | runs-on: ubuntu-latest 13 | steps: 14 | - name: Check out source 15 | uses: actions/checkout@v4 16 | with: 17 | path: ccl 18 | 19 | - name: Fetch bootstrapping binaries 20 | run: | 21 | # be silent, still report errors, 22 | # return a non-zero exit code on failure, 23 | # follow redirections 24 | curl -sSfL -O ${{ env.URL }} 25 | 26 | - name: Install bootstrapping binaries 27 | run: | 28 | cd ccl 29 | tar xf ../linuxx86.tar.gz 30 | 31 | - name: Compile lisp kernel 32 | run: | 33 | cd ccl/lisp-kernel/linuxx8664 34 | make 35 | 36 | - name: Rebuild CCL 37 | run: | 38 | cd ccl 39 | ./lx86cl64 --batch --quiet -n -e '(rebuild-ccl :clean t)' 2 | 3 | 4 | 5 | LSApplicationCategoryType 6 | public.app-category.developer-tools 7 | LSMinimumSystemVersion 8 | 10.6.6 9 | CFBundleDevelopmentRegion 10 | English 11 | CFBundleDocumentTypes 12 | 13 | 14 | CFBundleTypeExtensions 15 | 16 | log 17 | 18 | CFBundleTypeIconFile 19 | 20 | CFBundleTypeName 21 | AltConsoleDocumentType 22 | CFBundleTypeOSTypes 23 | 24 | TEXT 25 | 26 | CFBundleTypeRole 27 | Editor 28 | NSDocumentClass 29 | AltConsoleDocument 30 | 31 | 32 | CFBundleExecutable 33 | AltConsole 34 | CFBundleIconFile 35 | 36 | CFBundleIdentifier 37 | com.clozure.AltConsole 38 | CFBundleInfoDictionaryVersion 39 | 6.0 40 | CFBundlePackageType 41 | APPL 42 | CFBundleSignature 43 | ???? 44 | CFBundleVersion 45 | 0.1 46 | NSMainNibFile 47 | MainMenu 48 | NSPrincipalClass 49 | NSApplication 50 | 51 | 52 | -------------------------------------------------------------------------------- /cocoa-ide/altconsole/AltConsoleDocument.h: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright (C) 2003 Clozure Associates 3 | This file is part of OpenMCL. 4 | 5 | OpenMCL is licensed under the terms of the Lisp Lesser GNU Public 6 | License , known as the LLGPL and distributed with OpenMCL as the 7 | file "LICENSE". The LLGPL consists of a preamble and the LGPL, 8 | which is distributed with OpenMCL as the file "LGPL". Where these 9 | conflict, the preamble takes precedence. 10 | 11 | OpenMCL is referenced in the preamble as the "LIBRARY." 12 | 13 | The LLGPL is also available online at 14 | http://opensource.franz.com/preamble.html 15 | 16 | $Log: AltConsoleDocument.h,v $ 17 | Revision 1.2 2003/11/17 07:30:39 gb 18 | update copyright/license 19 | 20 | Revision 1.1.1.1 2003/11/17 07:14:42 gb 21 | initial checkin 22 | 23 | */ 24 | 25 | #import 26 | 27 | @interface AltConsoleDocument : NSDocument 28 | { 29 | NSFileHandle *in, *out, *err; 30 | NSTextView *textView; 31 | unsigned outpos; 32 | NSDictionary *local_typing_attributes, *system_output_attributes; 33 | NSTextField *indicator; 34 | NSTimer *watchdog; 35 | Boolean peerDied; 36 | } 37 | @end 38 | -------------------------------------------------------------------------------- /cocoa-ide/altconsole/AltConsoleDocumentController.h: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright (C) 2003 Clozure Associates 3 | This file is part of OpenMCL. 4 | 5 | OpenMCL is licensed under the terms of the Lisp Lesser GNU Public 6 | License , known as the LLGPL and distributed with OpenMCL as the 7 | file "LICENSE". The LLGPL consists of a preamble and the LGPL, 8 | which is distributed with OpenMCL as the file "LGPL". Where these 9 | conflict, the preamble takes precedence. 10 | 11 | OpenMCL is referenced in the preamble as the "LIBRARY." 12 | 13 | The LLGPL is also available online at 14 | http://opensource.franz.com/preamble.html 15 | 16 | $Log: AltConsoleDocumentController.h,v $ 17 | Revision 1.2 2003/11/17 07:30:39 gb 18 | update copyright/license 19 | 20 | Revision 1.1.1.1 2003/11/17 07:14:42 gb 21 | initial checkin 22 | 23 | */ 24 | 25 | 26 | #import 27 | 28 | @interface AltConsoleDocumentController : NSDocumentController { 29 | unsigned console_documents; 30 | pid_t peer_pid; 31 | NSString *peer_name; 32 | NSString *peer_herald; 33 | } 34 | 35 | - (NSString *)herald; 36 | 37 | - (void) add_console_document; 38 | - (void) remove_console_document; 39 | @end 40 | -------------------------------------------------------------------------------- /cocoa-ide/altconsole/AltConsoleDocumentController.m: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright (C) 2003 Clozure Associates 3 | This file is part of OpenMCL. 4 | 5 | OpenMCL is licensed under the terms of the Lisp Lesser GNU Public 6 | License , known as the LLGPL and distributed with OpenMCL as the 7 | file "LICENSE". The LLGPL consists of a preamble and the LGPL, 8 | which is distributed with OpenMCL as the file "LGPL". Where these 9 | conflict, the preamble takes precedence. 10 | 11 | OpenMCL is referenced in the preamble as the "LIBRARY." 12 | 13 | The LLGPL is also available online at 14 | http://opensource.franz.com/preamble.html 15 | 16 | $Log: AltConsoleDocumentController.m,v $ 17 | Revision 1.2 2003/11/17 07:30:39 gb 18 | update copyright/license 19 | 20 | Revision 1.1.1.1 2003/11/17 07:14:42 gb 21 | initial checkin 22 | 23 | */ 24 | 25 | #import "AltConsoleDocumentController.h" 26 | #include 27 | #include 28 | #include 29 | 30 | @implementation AltConsoleDocumentController 31 | 32 | - (id) init { 33 | self = [super init]; 34 | if (self) { 35 | ProcessSerialNumber psn; 36 | 37 | console_documents = 0; 38 | peer_pid = getppid(); 39 | peer_name = @"Unknown"; 40 | if (GetProcessForPID(peer_pid, &psn) == 0) { 41 | CFStringRef name; 42 | if (CopyProcessName(&psn, &name) == 0) { 43 | peer_name = [[NSString stringWithString: (NSString *)name] retain]; 44 | } 45 | } 46 | peer_herald = [[[NSString stringWithFormat: @"~/%@-%d",peer_name, peer_pid]stringByExpandingTildeInPath] retain]; 47 | } 48 | return self; 49 | } 50 | 51 | -(BOOL)validateMenuItem:(NSMenuItem *)item { 52 | if ([item action] == @selector(newDocument:)) { 53 | return (console_documents == 0); 54 | } 55 | return [super validateMenuItem:item]; 56 | } 57 | 58 | - (NSString *)herald { 59 | return peer_herald; 60 | } 61 | 62 | - (void) add_console_document { 63 | console_documents++; 64 | } 65 | 66 | - (void) remove_console_document { 67 | if (console_documents) { 68 | --console_documents; 69 | } 70 | } 71 | 72 | @end 73 | -------------------------------------------------------------------------------- /cocoa-ide/altconsole/Makefile: -------------------------------------------------------------------------------- 1 | # 2 | # $Log: Makefile,v $ 3 | # Revision 1.1.1.1 2003/11/17 07:14:42 gb 4 | # initial checkin 5 | # 6 | # 7 | 8 | INFO_PLIST = AltConsole-Info.plist 9 | 10 | ifdef MAC_APP_STORE 11 | INFO_PLIST = AltConsole-mas-Info.plist 12 | endif 13 | 14 | APPBASE=. 15 | OBJECTS=main.o AltConsoleDocument.o AltConsoleDocumentController.o 16 | RESOURCES=resource/MainMenu.nib resource/AltConsole.nib resource/Credits.rtf resource/InfoPlist.strings resource/Clear.tiff 17 | 18 | CFLAGS=-g -O -mmacosx-version-min=10.9 19 | 20 | AltConsole: $(OBJECTS) 21 | $(CC) $(CFLAGS) -o $@ $(OBJECTS) -framework Cocoa 22 | 23 | $(APPBASE)/AltConsole.app: AltConsole $(RESOURCES) AltConsole-Info.plist 24 | mkdir -p $(APPBASE) 25 | rm -rf $(APPBASE)/AltConsole.app 26 | mkdir -p $(APPBASE)/AltConsole.app/Contents/Resources/English.lproj 27 | cp -r -p $(RESOURCES) $(APPBASE)/AltConsole.app/Contents/Resources/English.lproj 28 | mkdir -p $(APPBASE)/AltConsole.app/Contents/MacOS 29 | cp -p AltConsole $(APPBASE)/AltConsole.app/Contents/MacOS 30 | cp -p $(INFO_PLIST) $(APPBASE)/AltConsole.app/Contents/Info.plist 31 | touch $(APPBASE)/AltConsole.app 32 | 33 | install: $(APPBASE)/AltConsole.app 34 | 35 | clean: 36 | rm -f AltConsole $(OBJECTS) *~ #* 37 | 38 | remove: clean 39 | rm -rf $(APPBASE)/AltConsole.app 40 | -------------------------------------------------------------------------------- /cocoa-ide/altconsole/resource/AltConsole.nib/classes.nib: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | IBClasses 6 | 7 | 8 | CLASS 9 | AltConsoleDocument 10 | LANGUAGE 11 | ObjC 12 | OUTLETS 13 | 14 | indicator 15 | id 16 | textView 17 | id 18 | 19 | SUPERCLASS 20 | NSDocument 21 | 22 | 23 | CLASS 24 | FirstResponder 25 | LANGUAGE 26 | ObjC 27 | SUPERCLASS 28 | NSObject 29 | 30 | 31 | IBVersion 32 | 1 33 | 34 | 35 | -------------------------------------------------------------------------------- /cocoa-ide/altconsole/resource/AltConsole.nib/info.nib: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | IBFramework Version 6 | 677 7 | IBOldestOS 8 | 5 9 | IBOpenObjects 10 | 11 | 43 12 | 13 | IBSystem Version 14 | 9J61 15 | targetFramework 16 | IBCocoaFramework 17 | 18 | 19 | -------------------------------------------------------------------------------- /cocoa-ide/altconsole/resource/AltConsole.nib/keyedobjects.nib: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/cocoa-ide/altconsole/resource/AltConsole.nib/keyedobjects.nib -------------------------------------------------------------------------------- /cocoa-ide/altconsole/resource/Clear.tiff: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/cocoa-ide/altconsole/resource/Clear.tiff -------------------------------------------------------------------------------- /cocoa-ide/altconsole/resource/Credits.rtf: -------------------------------------------------------------------------------- 1 | {\rtf1\mac\ansicpg10000\cocoartf102 2 | {\fonttbl\f0\fswiss\fcharset77 Helvetica;} 3 | {\colortbl;\red255\green255\blue255;} 4 | \vieww9600\viewh8400\viewkind0 5 | \pard\tx560\tx1120\tx1680\tx2240\tx2800\tx3360\tx3920\tx4480\tx5040\tx5600\tx6160\tx6720\ql\qnatural 6 | 7 | \f0\fs24 \cf0 This is a program that provides a simple way of capturing output from and directing input to a program that may have been launched with its standard input connected to the null device and its standard output/error streams attached to the system logging facility, e.g., most Carbon and Cocoa programs. Connecting those streams to a simple window like the ones this program provides enables such programs to interact with the user through those standard streams a little more easily, and that may be useful when the higher-level UI components of those programs can't be used.\ 8 | \ 9 | Gary Byers\ 10 | gb@clozure.com\ 11 | November, 2003\ 12 | } -------------------------------------------------------------------------------- /cocoa-ide/altconsole/resource/InfoPlist.strings: -------------------------------------------------------------------------------- 1 | /* Localized versions of Info.plist keys */ 2 | 3 | CFBundleShortVersionString = "0.1"; 4 | CFBundleGetInfoString = "altconsole version 0.1, Copyright 2003 Clozure Associates."; 5 | NSHumanReadableCopyright = "Copyright 2003 Clozure Associates."; 6 | -------------------------------------------------------------------------------- /cocoa-ide/altconsole/resource/MainMenu.nib/classes.nib: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | IBClasses 6 | 7 | 8 | CLASS 9 | FirstResponder 10 | LANGUAGE 11 | ObjC 12 | SUPERCLASS 13 | NSObject 14 | 15 | 16 | CLASS 17 | AltConsoleDocumentController 18 | LANGUAGE 19 | ObjC 20 | SUPERCLASS 21 | NSDocumentController 22 | 23 | 24 | IBVersion 25 | 1 26 | 27 | 28 | -------------------------------------------------------------------------------- /cocoa-ide/altconsole/resource/MainMenu.nib/info.nib: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | IBFramework Version 6 | 677 7 | IBOldestOS 8 | 5 9 | IBOpenObjects 10 | 11 | 29 12 | 13 | IBSystem Version 14 | 9J61 15 | targetFramework 16 | IBCocoaFramework 17 | 18 | 19 | -------------------------------------------------------------------------------- /cocoa-ide/altconsole/resource/MainMenu.nib/keyedobjects.nib: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/cocoa-ide/altconsole/resource/MainMenu.nib/keyedobjects.nib -------------------------------------------------------------------------------- /cocoa-ide/altconsole/resource/MainMenu.nib/objects.nib: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/cocoa-ide/altconsole/resource/MainMenu.nib/objects.nib -------------------------------------------------------------------------------- /cocoa-ide/altconsole/version.plist: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | BuildVersion 6 | 17 7 | CFBundleShortVersionString 8 | 0.1 9 | CFBundleVersion 10 | 0.1 11 | ProjectName 12 | NibPBTemplates 13 | SourceVersion 14 | 1150000 15 | 16 | 17 | -------------------------------------------------------------------------------- /cocoa-ide/builder-utilities.lisp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/cocoa-ide/builder-utilities.lisp -------------------------------------------------------------------------------- /cocoa-ide/cocoa.lisp: -------------------------------------------------------------------------------- 1 | ;;; 2 | ;;; Copyright 2016 Clozure Associates 3 | ;;; 4 | ;;; Licensed under the Apache License, Version 2.0 (the "License"); 5 | ;;; you may not use this file except in compliance with the License. 6 | ;;; You may obtain a copy of the License at 7 | ;;; 8 | ;;; http://www.apache.org/licenses/LICENSE-2.0 9 | ;;; 10 | ;;; Unless required by applicable law or agreed to in writing, software 11 | ;;; distributed under the License is distributed on an "AS IS" BASIS, 12 | ;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | ;;; See the License for the specific language governing permissions and 14 | ;;; limitations under the License. 15 | (in-package "CCL") 16 | 17 | #+windows-target 18 | (eval-when (:compile-toplevel :load-toplevel :execute) 19 | (pushnew :cocotron *features*)) 20 | 21 | (defvar *cocoa-ide-path* #+gz "ccl:GZ temp bundle.app;" #-gz 22 | (let* ((bits (nth-value 1 (host-platform)))) 23 | (format nil "ccl:temp bundle~a.app;" 24 | bits))) 25 | (defvar *cocoa-ide-copy-headers-p* nil) 26 | (defvar *cocoa-ide-install-altconsole* nil) 27 | (defvar *cocoa-ide-bundle-suffix* 28 | (multiple-value-bind (os bits cpu) (host-platform) 29 | (declare (ignore os)) 30 | (format nil "temp bundle-~a~a" (string-downcase cpu) bits))) 31 | (defvar *cocoa-ide-force-compile* nil) 32 | (defvar *cocoa-ide-frameworks* #+cocotron '("ccl:cocotron;Foundation.framework;" "ccl:cocotron;AppKit.framework;" "ccl:cocotron;CoreData.framework;") #-cocotron nil) 33 | (defvar *cocoa-ide-libraries* #+cocotron '("ccl:cocotron;Foundation>.1>.0.dll" "ccl:cocotron;AppKit>.1>.0.dll" "ccl:cocotron;CoreData>.1>.0.dll") #-cocotron nil) 34 | 35 | (load "ccl:cocoa-ide;defsystem.lisp") 36 | (load-ide *cocoa-ide-force-compile*) 37 | (gui::start-cocoa-ide) 38 | -------------------------------------------------------------------------------- /cocoa-ide/constants.lisp: -------------------------------------------------------------------------------- 1 | ;;; 2 | ;;; Copyright 2016 Clozure Associates 3 | ;;; 4 | ;;; Licensed under the Apache License, Version 2.0 (the "License"); 5 | ;;; you may not use this file except in compliance with the License. 6 | ;;; You may obtain a copy of the License at 7 | ;;; 8 | ;;; http://www.apache.org/licenses/LICENSE-2.0 9 | ;;; 10 | ;;; Unless required by applicable law or agreed to in writing, software 11 | ;;; distributed under the License is distributed on an "AS IS" BASIS, 12 | ;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | ;;; See the License for the specific language governing permissions and 14 | ;;; limitations under the License. 15 | 16 | (in-package "GUI") 17 | 18 | ;;; action menu item tags 19 | (defconstant $inspect-item-tag 0) 20 | (defconstant $source-item-tag 1) 21 | -------------------------------------------------------------------------------- /cocoa-ide/hemlock.lisp: -------------------------------------------------------------------------------- 1 | ;;;-*- Mode: LISP; Package: CCL -*- 2 | ;;; 3 | ;;; Copyright 2016 Clozure Associates 4 | ;;; 5 | ;;; Licensed under the Apache License, Version 2.0 (the "License"); 6 | ;;; you may not use this file except in compliance with the License. 7 | ;;; You may obtain a copy of the License at 8 | ;;; 9 | ;;; http://www.apache.org/licenses/LICENSE-2.0 10 | ;;; 11 | ;;; Unless required by applicable law or agreed to in writing, software 12 | ;;; distributed under the License is distributed on an "AS IS" BASIS, 13 | ;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | ;;; See the License for the specific language governing permissions and 15 | ;;; limitations under the License. 16 | 17 | (in-package "CCL") 18 | 19 | (require "COMPILE-HEMLOCK") 20 | 21 | (format t "~&;;; Compiling Hemlock ...") 22 | 23 | (compile-hemlock t) 24 | -------------------------------------------------------------------------------- /cocoa-ide/hemlock/INSTALL: -------------------------------------------------------------------------------- 1 | INSTALLATION NOTES 2 | 3 | Phemlock comes with a mk:defsystem style .system file. So when you are 4 | lucky you just can fire up your Lisp and say 5 | 6 | (oos :hemlock :load) 7 | 8 | (hemlock) 9 | 10 | This was tested with: 11 | 12 | - CMUCL 13 | - ACL 14 | - CLISP using MIT CLX 15 | 16 | 17 | -------------------------------------------------------------------------------- /cocoa-ide/hemlock/TODO: -------------------------------------------------------------------------------- 1 | TODO 2 | 3 | Feel free to stick your own notes into it, be sure to append a 4 | signature. 5 | 6 | - we need to get rid of hemlock11.cursor and hemlock11.mask 7 | --GB 2003-03-26 8 | 9 | - Provide the classes fundamental-character-{input|output}-stream for SCL 10 | 11 | - Write a style guide. 12 | . signed comments 13 | . no 80-characters-per-line limitations 14 | . no #+/#- in the main code body 15 | . no :: in the main code body 16 | . no changes to bindings in bindings.lisp 17 | unless one updates the manual too. 18 | 19 | - Import the scribe parser and work on the html converter 20 | 21 | $Id$ -------------------------------------------------------------------------------- /cocoa-ide/hemlock/doc/misc/hemlock.upd: -------------------------------------------------------------------------------- 1 | struct.lisp 2 | struct-ed.lisp 3 | rompsite.lisp 4 | charmacs.lisp 5 | key-event.lisp 6 | keysym-defs.lisp 7 | input.lisp 8 | macros.lisp 9 | line.lisp 10 | ring.lisp 11 | table.lisp 12 | htext1.lisp 13 | htext2.lisp 14 | htext3.lisp 15 | htext4.lisp 16 | search1.lisp 17 | search2.lisp 18 | linimage.lisp 19 | cursor.lisp 20 | syntax.lisp 21 | winimage.lisp 22 | hunk-draw.lisp 23 | @!bit-stream.lisp 24 | termcap.lisp 25 | display.lisp 26 | bit-display.lisp 27 | tty-disp-rt.lisp 28 | tty-display.lisp 29 | @!tty-stream.lisp 30 | pop-up-stream.lisp 31 | screen.lisp 32 | bit-screen.lisp 33 | tty-screen.lisp 34 | window.lisp 35 | font.lisp 36 | interp.lisp 37 | vars.lisp 38 | buffer.lisp 39 | files.lisp 40 | streams.lisp 41 | echo.lisp 42 | main.lisp 43 | echocoms.lisp 44 | defsyn.lisp 45 | command.lisp 46 | morecoms.lisp 47 | undo.lisp 48 | killcoms.lisp 49 | searchcoms.lisp 50 | filecoms.lisp 51 | indent.lisp 52 | lispmode.lisp 53 | comments.lisp 54 | fill.lisp 55 | text.lisp 56 | doccoms.lisp 57 | srccom.lisp 58 | group.lisp 59 | spell-rt.lisp 60 | spell-corr.lisp 61 | spell-aug.lisp 62 | spell-build.lisp 63 | spellcoms.lisp 64 | abbrev.lisp 65 | overwrite.lisp 66 | gosmacs.lisp 67 | ts-buf.lisp 68 | ts-stream.lisp 69 | eval-server.lisp 70 | lispeval.lisp 71 | lispbuf.lisp 72 | kbdmac.lisp 73 | icom.lisp 74 | scribe.lisp 75 | pascal.lisp 76 | edit-defs.lisp 77 | auto-save.lisp 78 | register.lisp 79 | xcoms.lisp 80 | unixcoms.lisp 81 | mh.lisp 82 | highlight.lisp 83 | dired.lisp 84 | diredcoms.lisp 85 | bufed.lisp 86 | lisp-lib.lisp 87 | completion.lisp 88 | shell.lisp 89 | debug.lisp 90 | netnews.lisp 91 | bindings.lisp 92 | compilation.order 93 | things-to-do.txt 94 | 95 | @! Files that don't get compiled, but you'd expect to be listed in a .upd file. 96 | @! 97 | @! .../tools/hemcom.lisp 98 | @! .../tools/hemload.lisp 99 | @! ed-integrity.lisp 100 | @! hi-integrity.lisp 101 | @! hemlock.log 102 | @! perq-hemlock.log 103 | @! hemlock.upd 104 | @! 105 | -------------------------------------------------------------------------------- /cocoa-ide/hemlock/doc/misc/notes.txt: -------------------------------------------------------------------------------- 1 | (defcommand "Find File From Sources" (p) 2 | "" "" 3 | (declare (ignore p)) 4 | (let ((point (current-point))) 5 | (with-mark ((start point) 6 | (end point)) 7 | (find-file-command 8 | nil 9 | (merge-pathnames "src:" 10 | (region-to-string (region (line-start start) 11 | (line-end end)))))))) 12 | 13 | * abbrev.lisp 14 | * doccoms.lisp 15 | * echo.lisp 16 | * echocoms.lisp 17 | * filecoms.lisp 18 | * lisp-lib.lisp ;Blew away help command, should do describe mode. 19 | * lispbuf.lisp 20 | * lispeval.lisp ;Maybe write MESSAGE-EVAL_FORM-RESULTS. 21 | * macros.lisp <<< Already changed in WORK: 22 | * mh.lisp <<< Ask Bill about INC in "Incorporate New Mail". 23 | * morecoms.lisp 24 | * register.lisp 25 | * scribe.lisp 26 | * searchcoms.lisp 27 | * spellcoms.lisp 28 | -------------------------------------------------------------------------------- /cocoa-ide/hemlock/doc/scribe-converter/NOTES: -------------------------------------------------------------------------------- 1 | Scribe Syntax 2 | 3 | The Syntax of Scribe is actually very nice. A command is always 4 | introduced by #\@ followed by the command name and arguments delimited 5 | by delimiters (sic). 6 | 7 | The following delimiter pairs are supported: 8 | 9 | { } [ ] < > ( ) " " ' ' 10 | 11 | 12 | 13 | $Id$ 14 | -------------------------------------------------------------------------------- /cocoa-ide/hemlock/doc/scribe-converter/README: -------------------------------------------------------------------------------- 1 | This directory should eventually contain a scribe to HTML converter 2 | using the same backend formatter as i used for the annotatable CLIM 3 | manual. 4 | 5 | Since very rare information about Scribe is available, we'll work by 6 | infering the neccessary information from the Scribe files we have at 7 | hand, see file NOTES for details. 8 | 9 | $Id$ 10 | 11 | 12 | 13 | -------------------------------------------------------------------------------- /cocoa-ide/hemlock/hemlock11.cursor: -------------------------------------------------------------------------------- 1 | #define noname_width 16 2 | #define noname_height 16 3 | #define noname_x_hot 3 4 | #define noname_y_hot 1 5 | static char noname_bits[] = { 6 | 0x00,0x00,0x08,0x00,0x18,0x00,0x38,0x00,0x78,0x00,0xf8,0x00,0xf8,0x01,0xf8, 7 | 0x03,0xf8,0x07,0xf8,0x00,0xd8,0x00,0x88,0x01,0x80,0x01,0x00,0x03,0x00,0x03, 8 | 0x00,0x00}; 9 | -------------------------------------------------------------------------------- /cocoa-ide/hemlock/hemlock11.mask: -------------------------------------------------------------------------------- 1 | #define noname_width 16 2 | #define noname_height 16 3 | static char noname_bits[] = { 4 | 0x0c,0x00,0x1c,0x00,0x3c,0x00,0x7c,0x00,0xfc,0x00,0xfc,0x01,0xfc,0x03,0xfc, 5 | 0x07,0xfc,0x0f,0xfc,0x0f,0xfc,0x01,0xdc,0x03,0xcc,0x03,0x80,0x07,0x80,0x07, 6 | 0x00,0x03}; 7 | -------------------------------------------------------------------------------- /cocoa-ide/hemlock/maint/publish: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | 3 | now=`date --iso` 4 | tempdir=/tmp/hemlock-publish/ 5 | rm -rf $tempdir 6 | mkdir $tempdir 7 | cd $tempdir ; 8 | cvs -d :pserver:gilbert@localhost:/hemlock export -D "`date`" -d hemlock-$now hemlock ; 9 | tar zcvf hemlock-$now.tar.gz hemlock-$now 10 | 11 | sed -e "s/%%DATE%%/$now/g" < hemlock-$now/website/index.html.in > index.html 12 | 13 | scp hemlock-$now.tar.gz unk6@rzstud1.rz.uni-karlsruhe.de:.public_html/export/ 14 | scp index.html unk6@rzstud1.rz.uni-karlsruhe.de:.public_html/hemlock/ 15 | 16 | ssh -l unk6 rzstud1.rz.uni-karlsruhe.de chmod a+r .public_html/export/hemlock-$now.tar.gz .public_html/hemlock/index.html 17 | 18 | # $Id$ 19 | -------------------------------------------------------------------------------- /cocoa-ide/hemlock/resources/mh-scan: -------------------------------------------------------------------------------- 1 | %4(putnumf(msg))%<(cur)+%| %>%<{replied}A%| %> \ 2 | %02(putnumf(mday{date}))-%(putstr(month{date}))%<{date} %|*%>\ 3 | %5(size) \ 4 | %<(mymbox{from})To:%14(putstrf(friendly{to}))%|%17(putstrf(friendly{from}))%> \ 5 | %{subject}%<{body} <<%{body}%> 6 | -------------------------------------------------------------------------------- /cocoa-ide/hemlock/src/pop-up-stream.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Log: hemlock.log; Package: Hemlock-Internals -*- 2 | ;;; 3 | ;;; ********************************************************************** 4 | ;;; This code was written as part of the CMU Common Lisp project at 5 | ;;; Carnegie Mellon University, and has been placed in the public domain. 6 | ;;; 7 | #+CMU (ext:file-comment 8 | "$Header$") 9 | ;;; 10 | ;;; ********************************************************************** 11 | ;;; 12 | ;;; This file contatins the stream operations for pop-up-displays. 13 | ;;; 14 | ;;; Written by Blaine Burks. 15 | ;;; 16 | 17 | (in-package :hemlock-internals) 18 | 19 | 20 | (defmethod stream-write-char ((stream random-typeout-stream) char) 21 | (insert-character (random-typeout-stream-mark stream) char)) 22 | 23 | (defmethod stream-write-string ((stream random-typeout-stream) string &optional start end) 24 | (setf start (or start 0)) 25 | (setf end (or end (length string))) 26 | (unless (and (eql start 0) (eql end (length string))) 27 | (setq string (subseq string start end))) 28 | (insert-string (random-typeout-stream-mark stream) string)) 29 | 30 | (defmethod stream-finish-output ((stream random-typeout-stream)) 31 | nil) 32 | 33 | (defmethod stream-force-output ((stream random-typeout-stream)) 34 | (stream-finish-output stream)) 35 | 36 | (defmethod stream-line-column ((stream random-typeout-stream)) 37 | (mark-charpos (random-typeout-stream-mark stream))) 38 | -------------------------------------------------------------------------------- /cocoa-ide/hemlock/unused/archive/elisp/README: -------------------------------------------------------------------------------- 1 | This is currently a work-in-progess. 2 | 3 | The aim is to build an environment taht lets most elisp packages run inside 4 | PHemlock. Two things that explicitly will not be handled is "emacs sockets" 5 | and "emacs sub-processes". There may be stubs for them, actuallym, there 6 | will probably be stubs for them. 7 | 8 | Currently, most of the code is horribly uncommented and there's next-to-no 9 | docstrings. This will be fixed, at some point. 10 | 11 | The current files in the implementation, with a description of my 12 | generals thoughts of what should go where: 13 | 14 | base.lisp: This is the "base elisp" implementation. Things here end up 15 | in the ELISP package and should in general be "user visible". 16 | 17 | codewalker.lisp: This is a code walker necessary to wrap "variable 18 | access". It's not the most well-tested piece of code in the 19 | world, but so far it hasn't fallen over on my test cases. 20 | 21 | hemlock-shims.lisp: This is functions that need to interact deeply 22 | with Hemlock (key definitions etc, etc). 23 | 24 | internals.lisp: This is the file for what ends up being needed but not 25 | fitting anywhere else. 26 | 27 | loadup.lisp: Load all files, in something approaching a sensible order. 28 | 29 | packages.lisp: Package definitions. 30 | 31 | read-table.lisp: Readtables and support functions. 32 | 33 | implementation-needed: Contains a tentative list of symbols in GNU 34 | Emacs that may or may not need sensible implementation before 35 | we're done. Theory is, once all built-ins are in place, we can 36 | then bootstrap off whatever files tag along with emacs, should 37 | anyone want to. 38 | 39 | Here are some things to look at before releasing: 40 | [new-bbox] 41 | |Warning: These variables are undefined: 42 | | MAJOR-MODE MODE-NAME 43 | | 44 | | 45 | |Warning: These functions are undefined: 46 | | DEFINE-KEY GET-BUFFER-CREATE MAKE-SPARSE-KEYMAP SET-BUFFER SWITCH-TO-BUFFER 47 | | USE-LOCAL-MAP 48 | 49 | 50 | 51 | 52 | //Ingvar 53 | -------------------------------------------------------------------------------- /cocoa-ide/hemlock/unused/archive/elisp/cmucl-hemlock-glue.lisp: -------------------------------------------------------------------------------- 1 | ;;; File to fix Irritating Impedance Mismatch between 2 | ;;; CMU CL Hemlock and PortableHemlock. 3 | 4 | #+cmu 5 | (unless (find-package :hemlock-ext) 6 | #-hemlock 7 | (progn 8 | (load "/usr/share/common-lisp/systems/cmucl-hemlock.system") 9 | (mk:oos :cmucl-hemlock :load)) 10 | 11 | ;; OK, here comes the nasty. CMUCLHemlock stuffs things in the "EXT" 12 | ;; package (system-dependent stuff, basically). We expect things to be 13 | ;; orderly and live in a Hemlock package. Thus: 14 | (common-lisp::enter-new-nicknames (find-package "EXTENSIONS") '("HEMLOCK-EXT"))) 15 | 16 | -------------------------------------------------------------------------------- /cocoa-ide/hemlock/unused/archive/elisp/compile.lisp: -------------------------------------------------------------------------------- 1 | (load "loadup") 2 | (compile-file "read-table") 3 | (compile-file "internals") 4 | (compile-file "codewalker") 5 | (compile-file "base") 6 | (compile-file "hemlock-shims") 7 | -------------------------------------------------------------------------------- /cocoa-ide/hemlock/unused/archive/elisp/loadup.lisp: -------------------------------------------------------------------------------- 1 | ;; Files to load 2 | (load "packages") 3 | (load "read-table") 4 | (load "base") 5 | (load "codewalker") 6 | (load "internals") 7 | (load "hemlock-shims") 8 | 9 | ;; Functions to call 10 | (let ((*package* (find-package :elisp))) 11 | (elisp-internals:generate-cl-package)) 12 | -------------------------------------------------------------------------------- /cocoa-ide/hemlock/unused/archive/elisp/packages.lisp: -------------------------------------------------------------------------------- 1 | (defpackage "ELISP" 2 | (:shadow "=" "DEFUN" "LET" "IF" "SETQ" "ASSOC" "COMMANDP" "AREF") 3 | (:use "COMMON-LISP" "HEMLOCK-INTERNALS") 4 | (:export 5 | "%" 6 | "=" 7 | "ABORT-RECURSIVE-EDIT" 8 | "AREF" 9 | "ASET" 10 | "ASSQ" 11 | "ASSOC" 12 | "AUTOLOAD" 13 | "BOBP" 14 | "BODY" 15 | "BOLP" 16 | "BOOL-VECTOR-P" 17 | "BUFFER-LOCAL-P" 18 | "CAR-LESS-THAN-CAR" 19 | "CAR-SAFE" 20 | "CDR-SAFE" 21 | "COMMANDP" 22 | "DEFMACRO" 23 | "DEFUN" 24 | "DEFVAR" 25 | "FEATURES" 26 | "FILENAME" 27 | "GET-BUFFER" 28 | "GET-BUFFER-CREATE" 29 | "GET-DEFAULT" 30 | "GLOBAL-SET-KEY" 31 | "IF" 32 | "INTERACTIVE" 33 | "KEY" 34 | "KEYMAP" 35 | "LET" 36 | "LEXICAL-LET" 37 | "LOAD-FILE" 38 | "LOAD-LIBRARY" 39 | "LOAD-PATH" 40 | "LOCAL-SET-KEY" 41 | "MAKE-BOOL-VECTOR" 42 | "MAKE-KEYMAP" 43 | "MAKE-VARIABLE-BUFFER-LOCAL" 44 | "MAKE-SPARSE-KEYMAP" 45 | "NOERROR" 46 | "SET-DEFAULT" 47 | "SETQ" 48 | "USE-LOCAL-MAP" 49 | "WHILE" 50 | ) 51 | ) 52 | (defpackage "ELISP-INTERNALS" 53 | (:shadow "READ-STRING") 54 | (:use "COMMON-LISP") 55 | (:export 56 | "FIND-LAMBDA-LIST-VARIABLES" 57 | "GENERATE-CL-PACKAGE" 58 | "REQUIRE-LOAD" 59 | "GET-USER-HOMEDIR" 60 | "INTERACTIVE-GLUE" 61 | "*ELISP-READTABLE*" 62 | ) 63 | ) 64 | (defpackage "ELISP-USER" 65 | (:use "ELISP" "ELISP-INTERNALS") 66 | ) 67 | -------------------------------------------------------------------------------- /cocoa-ide/hemlock/unused/archive/pascal.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Log: hemlock.log; Package: Hemlock -*- 2 | ;;; 3 | ;;; ********************************************************************** 4 | ;;; This code was written as part of the CMU Common Lisp project at 5 | ;;; Carnegie Mellon University, and has been placed in the public domain. 6 | ;;; 7 | #+CMU (ext:file-comment 8 | "$Header$") 9 | ;;; 10 | ;;; ********************************************************************** 11 | ;;; 12 | ;;; Just barely enough to be a Pascal/C mode. Maybe more some day. 13 | ;;; 14 | (in-package :hemlock) 15 | 16 | (defmode "Pascal" :major-p t) 17 | (defcommand "Pascal Mode" (p) 18 | "Put the current buffer into \"Pascal\" mode." 19 | "Put the current buffer into \"Pascal\" mode." 20 | (declare (ignore p)) 21 | (setf (buffer-major-mode (current-buffer)) "Pascal")) 22 | 23 | (defhvar "Indent Function" 24 | "Indentation function which is invoked by \"Indent\" command. 25 | It must take one argument that is the prefix argument." 26 | :value #'generic-indent 27 | :mode "Pascal") 28 | 29 | (defhvar "Auto Fill Space Indent" 30 | "When non-nil, uses \"Indent New Comment Line\" to break lines instead of 31 | \"New Line\"." 32 | :mode "Pascal" :value t) 33 | 34 | (defhvar "Comment Start" 35 | "String that indicates the start of a comment." 36 | :mode "Pascal" :value "(*") 37 | 38 | (defhvar "Comment End" 39 | "String that ends comments. Nil indicates #\newline termination." 40 | :mode "Pascal" :value " *)") 41 | 42 | (defhvar "Comment Begin" 43 | "String that is inserted to begin a comment." 44 | :mode "Pascal" :value "(* ") 45 | 46 | (shadow-attribute :scribe-syntax #\< nil "Pascal") 47 | -------------------------------------------------------------------------------- /cocoa-ide/hemlock/unused/archive/spell/README: -------------------------------------------------------------------------------- 1 | SPELL was originally part of Hemlock, CMUCL's Common Lisp text editor. 2 | This version has been mostly rewritten in portable ANSI CL. The only 3 | file that remains to be converted is spell-aug.lisp. Besides ripping 4 | out implementation-specific code, the biggest change is that the spelling 5 | dictionary is no longer a global variable. Instead, it has been 6 | converted to be a class; multiple dictionaries may thus coexist at any 7 | one time. Most functions have therefore been changed to take an extra 8 | DICTIONARY parameter. 9 | 10 | An ASDF system definition is contained in spell.asd. 11 | 12 | Semi-extensive testing has been done. However, a test suite would be 13 | a good thing to write. 14 | 15 | To get started, compile and load the system, then enter 16 | 17 | (SPELL::BUILD-DICTIONARY #p"/path/to/spell-dictionary.text" "outfile") 18 | (SETF MY-DICTIONARY *) 19 | (CORRECT-SPELLING MY-DICTIONARY "debugg") 20 | 21 | spellcoms.lisp is a file containing Hemlock commands and functions to 22 | integrate the SPELL package into Hemlock. It needs to be rewritten 23 | to work with the new code, but is an example of what can be done with 24 | the provided interfaces. 25 | 26 | Please email any comments, questions, or bug fixes to froydnj@cs.rice.edu. 27 | -------------------------------------------------------------------------------- /cocoa-ide/hemlock/unused/archive/spell/classes.lisp: -------------------------------------------------------------------------------- 1 | (in-package :spell) 2 | 3 | (defclass dictionary () 4 | ((string-table :accessor string-table :initarg :string-table) 5 | (descriptors :accessor descriptors :initarg :descriptors) 6 | ;; maps from hashes of strings to their corresponding descriptors 7 | (descriptor-table :accessor descriptor-table 8 | :initarg :descriptor-table) 9 | (free-descriptors :accessor free-descriptors 10 | :initarg :free-descriptors 11 | :initform 0) 12 | (free-string-table-bytes :accessor free-string-table-bytes 13 | :initarg :free-string-table-bytes 14 | :initform 0))) 15 | 16 | (defstruct (descriptor 17 | (:conc-name desc-)) 18 | hash-code 19 | length 20 | string-index 21 | flags) 22 | -------------------------------------------------------------------------------- /cocoa-ide/hemlock/unused/archive/spell/flags.lisp: -------------------------------------------------------------------------------- 1 | (in-package "SPELL") 2 | 3 | ;;; FIXME: show where these things are documented 4 | (defconstant +V-mask+ (ash 1 13)) 5 | (defconstant +N-mask+ (ash 1 12)) 6 | (defconstant +X-mask+ (ash 1 11)) 7 | (defconstant +H-mask+ (ash 1 10)) 8 | (defconstant +Y-mask+ (ash 1 9)) 9 | (defconstant +G-mask+ (ash 1 8)) 10 | (defconstant +J-mask+ (ash 1 7)) 11 | (defconstant +D-mask+ (ash 1 6)) 12 | (defconstant +T-mask+ (ash 1 5)) 13 | (defconstant +R-mask+ (ash 1 4)) 14 | (defconstant +Z-mask+ (ash 1 3)) 15 | (defconstant +S-mask+ (ash 1 2)) 16 | (defconstant +P-mask+ (ash 1 1)) 17 | (defconstant +M-mask+ 1) 18 | 19 | (defconstant flag-names-to-masks 20 | `((#\V . ,+V-mask+) (#\N . ,+N-mask+) (#\X . ,+X-mask+) 21 | (#\H . ,+H-mask+) (#\Y . ,+Y-mask+) (#\G . ,+G-mask+) 22 | (#\J . ,+J-mask+) (#\D . ,+D-mask+) (#\T . ,+T-mask+) 23 | (#\R . ,+R-mask+) (#\Z . ,+Z-mask+) (#\S . ,+S-mask+) 24 | (#\P . ,+P-mask+) (#\M . ,+M-mask+))) 25 | 26 | (defvar *flag-masks* 27 | (make-array 128 :element-type '(unsigned-byte 16) :initial-element 0) 28 | "This holds the masks for character flags, which is used when reading 29 | a text file of dictionary words. Illegal character flags hold zero.") 30 | 31 | (declaim (inline flag-mask)) 32 | (defun flag-mask (char) 33 | (aref *flag-masks* (char-code char))) 34 | (defun %set-flag-mask (char value) 35 | (setf (aref *flag-masks* (char-code char)) value)) 36 | 37 | (defsetf flag-mask %set-flag-mask) 38 | 39 | (dolist (e flag-names-to-masks) 40 | (let ((char (car e)) 41 | (mask (cdr e))) 42 | (setf (flag-mask char) mask) 43 | (setf (flag-mask (char-downcase char)) mask))) -------------------------------------------------------------------------------- /cocoa-ide/hemlock/unused/archive/spell/hashing.lisp: -------------------------------------------------------------------------------- 1 | (in-package "SPELL") 2 | 3 | ;;; FIXME: the original code included the below comment; obviously, it 4 | ;;; utilized implementation-specific primitives to speed up hashing. is 5 | ;;; this reasonable to do? 6 | ;;; 7 | ;;; STRING-HASH employs the instruction SXHASH-SIMPLE-SUBSTRING which takes 8 | ;;; an end argument, so we do not have to use SXHASH. SXHASH would mean 9 | ;;; doing a SUBSEQ of entry. 10 | (declaim (inline string-hash)) 11 | (defun string-hash (string length) 12 | (if (= length (length string)) 13 | (sxhash string) 14 | (sxhash (subseq string 0 length)))) 15 | -------------------------------------------------------------------------------- /cocoa-ide/hemlock/unused/archive/spell/package.lisp: -------------------------------------------------------------------------------- 1 | (defpackage "SPELL" 2 | (:use "COMMON-LISP") 3 | (:export #:spell-try-word #:spell-root-word #:spell-collect-close-words 4 | #:correct-spelling 5 | #:+max-entry-length+ 6 | #:spell-read-dictionary #:spell-add-entry #:spell-root-flags 7 | #:spell-remove-entry)) -------------------------------------------------------------------------------- /cocoa-ide/hemlock/unused/archive/spell/spell.asd: -------------------------------------------------------------------------------- 1 | ;;; -*- mode: lisp -*- 2 | (defpackage :spell-system (:use :cl :asdf)) 3 | (in-package :spell-system) 4 | 5 | (defsystem spell 6 | :version "0.4" 7 | :components ((:file "package") 8 | (:file "constants" :depends-on ("package")) 9 | (:file "hashing" :depends-on ("package")) 10 | (:file "flags") 11 | (:file "classes" :depends-on ("package")) 12 | (:file "build" :depends-on ("constants" "hashing" 13 | "flags" "classes")) 14 | ;; kind of a fake dependency 15 | (:file "io" :depends-on ("build")) 16 | (:file "correlate" :depends-on ("build")))) -------------------------------------------------------------------------------- /cocoa-ide/hemlock/unused/archive/wire/Notes: -------------------------------------------------------------------------------- 1 | Wire was using its own buffer management -- how useful. We did away 2 | with that an read/write directly from an binary stream for now. 3 | 4 | TODO 5 | 6 | - actually switch to binary streams 7 | - invent something for strings (say define it as unicode or something) 8 | 9 | - can we do a reasonable attempt to make symbol lookup work across 10 | lisp implementations? 11 | 12 | - can we make this at least somewhat work with CLISP? 13 | 14 | - conditions. 15 | 16 | - Do away with superfluous large macros 17 | 18 | - Can we again do with a serve event kind of interface for poor Lisp 19 | which do not feature multiprocessing (like say CLISP)? 20 | 21 | 22 | -------------------------------------------------------------------------------- /cocoa-ide/hemlock/unused/archive/wire/package.lisp: -------------------------------------------------------------------------------- 1 | (defpackage :hemlock.wire 2 | (:use :common-lisp) 3 | (:nicknames :wire) 4 | (:export 5 | ;; wire.lisp 6 | #:remote-object-p 7 | #:remote-object 8 | #:remote-object-local-p 9 | #:remote-object-eq 10 | #:remote-object-value 11 | #:make-remote-object 12 | #:forget-remote-translation 13 | #:make-wire 14 | #:wire-p 15 | #:wire-fd 16 | #:wire-listen 17 | #:wire-get-byte 18 | #:wire-get-number 19 | #:wire-get-string 20 | #:wire-get-object 21 | #:wire-force-output 22 | #:wire-output-byte 23 | #:wire-output-number 24 | #:wire-output-string 25 | #:wire-output-object 26 | #:wire-output-funcall 27 | #:wire-error 28 | #:wire-eof 29 | #:wire-io-error 30 | #:*current-wire* 31 | #:wire-get-bignum 32 | #:wire-output-bignum 33 | ;; remote.lisp 34 | #:remote 35 | #:remote-value 36 | #:remote-value-bind 37 | #:create-request-server 38 | #:destroy-request-server 39 | #:connect-to-remote-server)) 40 | 41 | -------------------------------------------------------------------------------- /cocoa-ide/hemlock/unused/archive/xcoms.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Log: hemlock.log; Package: Hemlock -*- 2 | ;;; 3 | ;;; ********************************************************************** 4 | ;;; This code was written as part of the CMU Common Lisp project at 5 | ;;; Carnegie Mellon University, and has been placed in the public domain. 6 | ;;; 7 | #+CMU (ext:file-comment 8 | "$Header$") 9 | ;;; 10 | ;;; ********************************************************************** 11 | ;;; 12 | ;;; This file contains commands and support specifically for X related features. 13 | ;;; 14 | ;;; Written by Bill Chiles. 15 | ;;; 16 | 17 | (in-package :hemlock) 18 | 19 | 20 | (defcommand "Region to Cut Buffer" (p) 21 | "Place the current region into the X cut buffer." 22 | "Place the current region into the X cut buffer." 23 | (declare (ignore p)) 24 | (store-cut-string (hi::bitmap-device-display 25 | (hi::device-hunk-device (hi::window-hunk (current-window)))) 26 | (region-to-string (current-region)))) 27 | 28 | (defcommand "Insert Cut Buffer" (p) 29 | "Insert the X cut buffer at current point." 30 | "Insert the X cut buffer at current point. Returns nil when it is empty." 31 | (declare (ignore p)) 32 | (let ((str (fetch-cut-string (hi::bitmap-device-display 33 | (hi::device-hunk-device 34 | (hi::window-hunk (current-window))))))) 35 | (if str 36 | (let ((point (current-point))) 37 | (push-buffer-mark (copy-mark point)) 38 | (insert-string (current-point) str)) 39 | (editor-error "X cut buffer empty."))) 40 | (setf (last-command-type) :ephemerally-active)) 41 | -------------------------------------------------------------------------------- /cocoa-ide/hemlock/unused/gosmacs.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Package: Hemlock; Log: Hemlock.Log -*- 2 | ;;; 3 | ;;; ********************************************************************** 4 | ;;; This code was written as part of the CMU Common Lisp project at 5 | ;;; Carnegie Mellon University, and has been placed in the public domain. 6 | ;;; 7 | #+CMU (ext:file-comment 8 | "$Header$") 9 | ;;; 10 | ;;; ********************************************************************** 11 | ;;; 12 | ;;; Stuff in this file provides some degree of upward compatibility 13 | ;;; for incurable Gosling Emacs users. 14 | ;;; 15 | (in-package "HEMLOCK") 16 | 17 | (defcommand "Gosmacs Permute Characters" (p) 18 | "Transpose the two characters before the point." 19 | "Transpose the two characters before the point." 20 | (declare (ignore p)) 21 | (with-mark ((m (current-point) :left-inserting)) 22 | (unless (and (mark-before m) (previous-character m)) 23 | (editor-error "NIB You have addressed a character not in the buffer?")) 24 | (rotatef (previous-character m) (next-character m)))) 25 | 26 | (bind-key "Gosmacs Permute Characters" #k"control-t") 27 | (bind-key "Kill Previous Word" #k"meta-h") 28 | (bind-key "Replace String" #k"meta-r") 29 | (bind-key "Query Replace" #k"meta-q") 30 | (bind-key "Fill Paragraph" #k"meta-j") 31 | (bind-key "Visit File" #k"control-x control-r") 32 | (bind-key "Find File" #k"control-x control-v") 33 | (bind-key "Insert File" #k"control-x control-i") 34 | -------------------------------------------------------------------------------- /cocoa-ide/hemlock/unused/hacks.lisp: -------------------------------------------------------------------------------- 1 | (in-package "HI") 2 | 3 | (defun %sp-byte-blt (src start dest dstart end) 4 | (%primitive byte-blt src start dest dstart end)) 5 | 6 | (defun lisp::sap-to-fixnum (x) (sap-int x)) 7 | (defun lisp::fixnum-to-sap (x) (int-sap x)) 8 | (defun lisp::%sp-make-fixnum (x) (%primitive make-fixnum x)) 9 | (defun lisp::fast-char-upcase (x) (char-upcase x)) 10 | 11 | ;;; prepare-window-for-redisplay -- Internal 12 | ;;; 13 | ;;; Called by make-window to do whatever redisplay wants to set up 14 | ;;; a new window. 15 | ;;; 16 | (defun prepare-window-for-redisplay (window) 17 | (setf (window-old-lines window) 0)) 18 | 19 | (defparameter hunk-width-limit 256) 20 | 21 | (defun reverse-video-hook-fun (&rest foo) 22 | (declare (ignore foo))) 23 | -------------------------------------------------------------------------------- /cocoa-ide/hemlock/unused/struct-ed.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Log: hemlock.log; Package: Hemlock-*- 2 | ;;; 3 | ;;; ********************************************************************** 4 | ;;; This code was written as part of the CMU Common Lisp project at 5 | ;;; Carnegie Mellon University, and has been placed in the public domain. 6 | ;;; 7 | #+CMU (ext:file-comment 8 | "$Header$") 9 | ;;; 10 | ;;; ********************************************************************** 11 | ;;; 12 | ;;; Structures used by constucts in the HEMLOCK package. 13 | ;;; 14 | 15 | (in-package "HEMLOCK") 16 | 17 | ;;; The server-info structure holds information about the connection to a 18 | ;;; particular eval server. For now, we don't separate the background I/O and 19 | ;;; random compiler output. The Notifications port and Terminal_IO will be the 20 | ;;; same identical object. This separation in the interface may be just 21 | ;;; gratuitous pseudo-generality, but it doesn't hurt. 22 | ;;; 23 | (defstruct (server-info 24 | (:print-function 25 | (lambda (s stream d) 26 | (declare (ignore d)) 27 | (format stream "#" (server-info-name s))))) 28 | name ; String name of this server. 29 | port ; Port we send requests to. 30 | ; NullPort if no connection. 31 | notifications ; List of notification objects for operations 32 | ; which have not yet completed. 33 | ts-info ; Ts-Info structure of typescript we use in 34 | ; "background" buffer. 35 | buffer ; Buffer "background" typescript is in. 36 | slave-ts ; Ts-Info used in "Slave Lisp" buffer 37 | ; (formerly the "Lisp Listener" buffer). 38 | slave-buffer ; "Slave Lisp" buffer for slave's *terminal-io*. 39 | errors ; List of structures describing reported errors. 40 | error-mark) ; Pointer after last error edited. 41 | -------------------------------------------------------------------------------- /cocoa-ide/ide-application.lisp: -------------------------------------------------------------------------------- 1 | ;;; 2 | ;;; Copyright 2016 Clozure Associates 3 | ;;; 4 | ;;; Licensed under the Apache License, Version 2.0 (the "License"); 5 | ;;; you may not use this file except in compliance with the License. 6 | ;;; You may obtain a copy of the License at 7 | ;;; 8 | ;;; http://www.apache.org/licenses/LICENSE-2.0 9 | ;;; 10 | ;;; Unless required by applicable law or agreed to in writing, software 11 | ;;; distributed under the License is distributed on an "AS IS" BASIS, 12 | ;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | ;;; See the License for the specific language governing permissions and 14 | ;;; limitations under the License. 15 | 16 | (in-package :gui) 17 | 18 | (defclass ide-application (ccl::ccl-application) 19 | ((console :foreign-type :id :accessor console)) 20 | (:metaclass ns:+ns-object)) 21 | 22 | (objc:defmethod (#/stringToPasteBoard: :void) ((self ide-application) string) 23 | (let* ((pb (#/generalPasteboard ns:ns-pasteboard))) 24 | (#/declareTypes:owner: pb (#/arrayWithObject: ns:ns-array #&NSStringPboardType) nil) 25 | (#/setString:forType: pb string #&NSStringPboardType))) 26 | 27 | -------------------------------------------------------------------------------- /cocoa-ide/ide-contents/PkgInfo: -------------------------------------------------------------------------------- 1 | APPLOMCL -------------------------------------------------------------------------------- /cocoa-ide/ide-contents/Resources/Appearance.tiff: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/cocoa-ide/ide-contents/Resources/Appearance.tiff -------------------------------------------------------------------------------- /cocoa-ide/ide-contents/Resources/Documentation.icns: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/cocoa-ide/ide-contents/Resources/Documentation.icns -------------------------------------------------------------------------------- /cocoa-ide/ide-contents/Resources/Encodings.tiff: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/cocoa-ide/ide-contents/Resources/Encodings.tiff -------------------------------------------------------------------------------- /cocoa-ide/ide-contents/Resources/English.lproj/Authenticate.nib/keyedobjects.nib: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/cocoa-ide/ide-contents/Resources/English.lproj/Authenticate.nib/keyedobjects.nib -------------------------------------------------------------------------------- /cocoa-ide/ide-contents/Resources/English.lproj/Credits.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 14 | 15 | 16 |

17 | To report bugs or request enhancements, please go to the 18 | GitHub page for CCL 19 | and create an issue. 20 |

21 | 22 | 23 | -------------------------------------------------------------------------------- /cocoa-ide/ide-contents/Resources/English.lproj/OpenmclInspector.nib/classes.nib: -------------------------------------------------------------------------------- 1 | { 2 | IBClasses = ( 3 | {CLASS = FirstResponder; LANGUAGE = ObjC; SUPERCLASS = NSObject; }, 4 | { 5 | ACTIONS = {browserAction = id; browserDoubleAction = id; }; 6 | CLASS = InspectorBrowserDelegate; 7 | LANGUAGE = ObjC; 8 | OUTLETS = {inspectorTableView = NSTableView; inspectorWindow = NSWindow; }; 9 | SUPERCLASS = NSObject; 10 | }, 11 | {CLASS = InspectorNSBrowser; LANGUAGE = ObjC; SUPERCLASS = NSBrowser; }, 12 | { 13 | CLASS = InspectorTableViewDataSource; 14 | LANGUAGE = ObjC; 15 | OUTLETS = {inspectorBrowser = NSBrowser; inspectorWindow = NSWindow; }; 16 | SUPERCLASS = NSObject; 17 | }, 18 | { 19 | CLASS = InspectorTableViewDelegate; 20 | LANGUAGE = ObjC; 21 | OUTLETS = {inspectorWindow = NSWindow; }; 22 | SUPERCLASS = NSObject; 23 | }, 24 | { 25 | CLASS = InspectorWindowController; 26 | LANGUAGE = ObjC; 27 | OUTLETS = {inspectorBrowser = NSBrowser; }; 28 | SUPERCLASS = NSWindowController; 29 | } 30 | ); 31 | IBVersion = 1; 32 | } -------------------------------------------------------------------------------- /cocoa-ide/ide-contents/Resources/English.lproj/OpenmclInspector.nib/info.nib: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | IBDocumentLocation 6 | 58 65 356 240 0 0 1280 1002 7 | IBFramework Version 8 | 446.1 9 | IBOpenObjects 10 | 11 | 21 12 | 13 | IBSystem Version 14 | 8L2127 15 | IBUsesTextArchiving 16 | 17 | 18 | 19 | -------------------------------------------------------------------------------- /cocoa-ide/ide-contents/Resources/English.lproj/ProgressWindow.nib/keyedobjects.nib: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/cocoa-ide/ide-contents/Resources/English.lproj/ProgressWindow.nib/keyedobjects.nib -------------------------------------------------------------------------------- /cocoa-ide/ide-contents/Resources/English.lproj/SearchFiles.nib/keyedobjects.nib: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/cocoa-ide/ide-contents/Resources/English.lproj/SearchFiles.nib/keyedobjects.nib -------------------------------------------------------------------------------- /cocoa-ide/ide-contents/Resources/English.lproj/SearchFilesPreLion.nib/classes.nib: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | IBClasses 6 | 7 | 8 | CLASS 9 | NSObject 10 | LANGUAGE 11 | ObjC 12 | 13 | 14 | ACTIONS 15 | 16 | doBrowse 17 | id 18 | doSearch 19 | id 20 | editLine 21 | id 22 | expandResults 23 | id 24 | toggleCheckbox 25 | id 26 | updateFileNameString 27 | id 28 | updateFindString 29 | id 30 | updateFolderString 31 | id 32 | 33 | CLASS 34 | SearchFilesWindowController 35 | LANGUAGE 36 | ObjC 37 | OUTLETS 38 | 39 | browseButton 40 | id 41 | caseSensitiveCheckbox 42 | id 43 | expandResultsCheckbox 44 | id 45 | fileNameComboBox 46 | id 47 | findComboBox 48 | id 49 | folderComboBox 50 | id 51 | outlineView 52 | id 53 | progressIndicator 54 | id 55 | recursiveCheckbox 56 | id 57 | searchButton 58 | id 59 | searchCommentsCheckbox 60 | id 61 | statusField 62 | id 63 | 64 | SUPERCLASS 65 | NSWindowController 66 | 67 | 68 | IBVersion 69 | 1 70 | 71 | 72 | -------------------------------------------------------------------------------- /cocoa-ide/ide-contents/Resources/English.lproj/SearchFilesPreLion.nib/info.nib: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | IBFramework Version 6 | 677 7 | IBLastKnownRelativeProjectPath 8 | ../SearchFiles.xcodeproj 9 | IBOldestOS 10 | 4 11 | IBOpenObjects 12 | 13 | 2 14 | 15 | IBSystem Version 16 | 9L30 17 | targetFramework 18 | IBCocoaFramework 19 | 20 | 21 | -------------------------------------------------------------------------------- /cocoa-ide/ide-contents/Resources/English.lproj/SearchFilesPreLion.nib/keyedobjects.nib: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/cocoa-ide/ide-contents/Resources/English.lproj/SearchFilesPreLion.nib/keyedobjects.nib -------------------------------------------------------------------------------- /cocoa-ide/ide-contents/Resources/English.lproj/apropos.nib/classes.nib: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | IBClasses 6 | 7 | 8 | ACTIONS 9 | 10 | apropos 11 | id 12 | definitionForSelectedSymbol 13 | id 14 | inspectSelectedSymbol 15 | id 16 | setPackage 17 | id 18 | toggleShowsExternalSymbols 19 | id 20 | 21 | CLASS 22 | AproposWindowController 23 | LANGUAGE 24 | ObjC 25 | OUTLETS 26 | 27 | arrayController 28 | id 29 | comboBox 30 | id 31 | externalSymbolsCheckbox 32 | id 33 | tableView 34 | id 35 | textView 36 | id 37 | 38 | SUPERCLASS 39 | NSWindowController 40 | 41 | 42 | CLASS 43 | PackageComboBox 44 | LANGUAGE 45 | ObjC 46 | OUTLETS 47 | 48 | dataSource 49 | id 50 | 51 | 52 | 53 | IBVersion 54 | 1 55 | 56 | 57 | -------------------------------------------------------------------------------- /cocoa-ide/ide-contents/Resources/English.lproj/apropos.nib/info.nib: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | IBFramework Version 6 | 629 7 | IBOldestOS 8 | 5 9 | IBOpenObjects 10 | 11 | 133 12 | 13 | IBSystem Version 14 | 9C31 15 | targetFramework 16 | IBCocoaFramework 17 | 18 | 19 | -------------------------------------------------------------------------------- /cocoa-ide/ide-contents/Resources/English.lproj/apropos.nib/keyedobjects.nib: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/cocoa-ide/ide-contents/Resources/English.lproj/apropos.nib/keyedobjects.nib -------------------------------------------------------------------------------- /cocoa-ide/ide-contents/Resources/English.lproj/backtrace.nib/keyedobjects.nib: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/cocoa-ide/ide-contents/Resources/English.lproj/backtrace.nib/keyedobjects.nib -------------------------------------------------------------------------------- /cocoa-ide/ide-contents/Resources/English.lproj/displaydoc.nib/classes.nib: -------------------------------------------------------------------------------- 1 | { 2 | IBClasses = ( 3 | { 4 | CLASS = DisplayDocument; 5 | LANGUAGE = ObjC; 6 | OUTLETS = {textView = NSTextView; }; 7 | SUPERCLASS = NSDocument; 8 | } 9 | ); 10 | IBVersion = 1; 11 | } -------------------------------------------------------------------------------- /cocoa-ide/ide-contents/Resources/English.lproj/displaydoc.nib/info.nib: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | IBDocumentLocation 6 | 152 222 356 240 0 0 1280 1002 7 | IBFramework Version 8 | 446.1 9 | IBOldestOS 10 | 5 11 | IBSystem Version 12 | 8P135 13 | IBUsesTextArchiving 14 | 15 | targetFramework 16 | IBCocoaFramework 17 | 18 | 19 | -------------------------------------------------------------------------------- /cocoa-ide/ide-contents/Resources/English.lproj/inspector.nib/keyedobjects.nib: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/cocoa-ide/ide-contents/Resources/English.lproj/inspector.nib/keyedobjects.nib -------------------------------------------------------------------------------- /cocoa-ide/ide-contents/Resources/English.lproj/processes.nib/classes.nib: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | IBClasses 6 | 7 | 8 | ACTIONS 9 | 10 | killSelectedProcess 11 | id 12 | refresh 13 | id 14 | 15 | CLASS 16 | ProcessesWindowController 17 | LANGUAGE 18 | ObjC 19 | OUTLETS 20 | 21 | tableView 22 | NSTableView 23 | 24 | SUPERCLASS 25 | NSWindowController 26 | 27 | 28 | CLASS 29 | FirstResponder 30 | LANGUAGE 31 | ObjC 32 | SUPERCLASS 33 | NSObject 34 | 35 | 36 | IBVersion 37 | 1 38 | 39 | 40 | -------------------------------------------------------------------------------- /cocoa-ide/ide-contents/Resources/English.lproj/processes.nib/info.nib: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | IBFramework Version 6 | 628 7 | IBOldestOS 8 | 4 9 | IBOpenObjects 10 | 11 | IBSystem Version 12 | 9A559 13 | targetFramework 14 | IBCocoaFramework 15 | 16 | 17 | -------------------------------------------------------------------------------- /cocoa-ide/ide-contents/Resources/English.lproj/processes.nib/keyedobjects.nib: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/cocoa-ide/ide-contents/Resources/English.lproj/processes.nib/keyedobjects.nib -------------------------------------------------------------------------------- /cocoa-ide/ide-contents/Resources/English.lproj/project.nib/keyedobjects.nib: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/cocoa-ide/ide-contents/Resources/English.lproj/project.nib/keyedobjects.nib -------------------------------------------------------------------------------- /cocoa-ide/ide-contents/Resources/English.lproj/updateCCL.nib/keyedobjects.nib: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/cocoa-ide/ide-contents/Resources/English.lproj/updateCCL.nib/keyedobjects.nib -------------------------------------------------------------------------------- /cocoa-ide/ide-contents/Resources/English.lproj/xapropos.nib/classes.nib: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | IBClasses 6 | 7 | 8 | ACTIONS 9 | 10 | inspect 11 | id 12 | search 13 | id 14 | setSearchCategory 15 | id 16 | source 17 | id 18 | toggleExternalOnly 19 | id 20 | 21 | CLASS 22 | XaproposWindowController 23 | LANGUAGE 24 | ObjC 25 | OUTLETS 26 | 27 | actionMenu 28 | id 29 | actionPopupButton 30 | id 31 | allSymbolsButton 32 | id 33 | contextualMenu 34 | id 35 | externalSymbolsButton 36 | id 37 | searchField 38 | id 39 | searchFieldToolbarItem 40 | id 41 | tableView 42 | id 43 | window 44 | id 45 | 46 | 47 | 48 | IBVersion 49 | 1 50 | 51 | 52 | -------------------------------------------------------------------------------- /cocoa-ide/ide-contents/Resources/English.lproj/xapropos.nib/info.nib: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | IBFramework Version 6 | 677 7 | IBOldestOS 8 | 4 9 | IBOpenObjects 10 | 11 | 113 12 | 139 13 | 14 | IBSystem Version 15 | 9J61 16 | targetFramework 17 | IBCocoaFramework 18 | 19 | 20 | -------------------------------------------------------------------------------- /cocoa-ide/ide-contents/Resources/English.lproj/xapropos.nib/keyedobjects.nib: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/cocoa-ide/ide-contents/Resources/English.lproj/xapropos.nib/keyedobjects.nib -------------------------------------------------------------------------------- /cocoa-ide/ide-contents/Resources/English.lproj/xinspector.nib/keyedobjects.nib: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/cocoa-ide/ide-contents/Resources/English.lproj/xinspector.nib/keyedobjects.nib -------------------------------------------------------------------------------- /cocoa-ide/ide-contents/Resources/General.tiff: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/cocoa-ide/ide-contents/Resources/General.tiff -------------------------------------------------------------------------------- /cocoa-ide/ide-contents/Resources/Help/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | OpenMCL Help 6 | 7 | 8 | 9 |

OpenMCL Help

10 | 11 |

Aren't you glad you waited so long to see this window ?

12 | 13 |

The OpenMCL Doc directory is available here. 14 |

15 | 16 |

Some notes about the Cocoa-based development environment are 17 | available here. 18 |

19 | 20 |
21 | 22 | 23 | Last modified: Mon Jun 3 02:18:04 MDT 2002 24 | 25 | 26 | 27 | -------------------------------------------------------------------------------- /cocoa-ide/ide-contents/Resources/collapse-all.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/cocoa-ide/ide-contents/Resources/collapse-all.png -------------------------------------------------------------------------------- /cocoa-ide/ide-contents/Resources/expand-all.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/cocoa-ide/ide-contents/Resources/expand-all.png -------------------------------------------------------------------------------- /cocoa-ide/ide-contents/Resources/font-panel.tiff: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/cocoa-ide/ide-contents/Resources/font-panel.tiff -------------------------------------------------------------------------------- /cocoa-ide/ide-contents/Resources/gear.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/cocoa-ide/ide-contents/Resources/gear.png -------------------------------------------------------------------------------- /cocoa-ide/ide-contents/Resources/info.tiff: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/cocoa-ide/ide-contents/Resources/info.tiff -------------------------------------------------------------------------------- /cocoa-ide/ide-contents/Resources/openmcl-icon.icns: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/cocoa-ide/ide-contents/Resources/openmcl-icon.icns -------------------------------------------------------------------------------- /cocoa-ide/ide-contents/Resources/openmcl-icon.ico: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/cocoa-ide/ide-contents/Resources/openmcl-icon.ico -------------------------------------------------------------------------------- /compiler/ARM64/arm64-arch.lisp: -------------------------------------------------------------------------------- 1 | (defpackage "ARM64" 2 | (:use "CL") 3 | #+arm64-target 4 | (:nicknames "TARGET")) 5 | 6 | (require "ARCH") 7 | 8 | (in-package "ARM64") 9 | 10 | 11 | 12 | (provide "ARM64-ARCH") 13 | -------------------------------------------------------------------------------- /compiler/nx-base-app.lisp: -------------------------------------------------------------------------------- 1 | ;;;-*-Mode: LISP; Package: CCL -*- 2 | ;;; 3 | ;;; Copyright 1994-2009 Clozure Associates 4 | ;;; 5 | ;;; Licensed under the Apache License, Version 2.0 (the "License"); 6 | ;;; you may not use this file except in compliance with the License. 7 | ;;; You may obtain a copy of the License at 8 | ;;; 9 | ;;; http://www.apache.org/licenses/LICENSE-2.0 10 | ;;; 11 | ;;; Unless required by applicable law or agreed to in writing, software 12 | ;;; distributed under the License is distributed on an "AS IS" BASIS, 13 | ;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | ;;; See the License for the specific language governing permissions and 15 | ;;; limitations under the License. 16 | 17 | 18 | ; Loaded instead of compiler for standalone applications. 19 | 20 | (in-package "CCL") 21 | 22 | ;(require 'numbers) 23 | (require 'sort) 24 | (require 'hash) 25 | 26 | ; this file is now equiv to nx-basic 27 | (%include "ccl:compiler;nx-basic.lisp") ; get cons-var, augment-environment 28 | ; nx-basic includes lambda-list 29 | 30 | ; End of nx-base-app.lisp 31 | -------------------------------------------------------------------------------- /doc/README: -------------------------------------------------------------------------------- 1 | See http://ccl.clozure.com/docs for preformatted versions of 2 | the documentation. 3 | 4 | The CCL manual in the manual/ directory is written in CCLDoc 5 | notation. The CCLDoc system can be obtained from 6 | https://github.com/Clozure/ccldoc. 7 | 8 | -------------------------------------------------------------------------------- /doc/compiler-changes-in-CCL-1.12-trunk.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/doc/compiler-changes-in-CCL-1.12-trunk.pdf -------------------------------------------------------------------------------- /doc/internals/.gitignore: -------------------------------------------------------------------------------- 1 | internals.html 2 | -------------------------------------------------------------------------------- /doc/internals/Makefile: -------------------------------------------------------------------------------- 1 | # Makefile to format CCL user manual. 2 | # 3 | # The manual is written in a notation called CCLDoc. Its GitHub project 4 | # may be found at https://github.com/Clozure/ccldoc 5 | 6 | # The CCL you want to use. 7 | CCL=ccl 8 | 9 | # Directory where your checkout of CCLDoc is. 10 | # Get CCLDoc with: 11 | # git clone https://github.com/Clozure/ccldoc.git 12 | CCLDOC_ROOT=~/ccl/ccldoc 13 | 14 | CSS=../manual/style.css 15 | 16 | ccl.html: *.ccldoc $(CSS) 17 | $(CCL) --batch \ 18 | -e "(require :asdf)" \ 19 | -e "(push \"$(CCLDOC_ROOT)/source/\" asdf:*central-registry*)" \ 20 | -e "(asdf:load-system :ccldoc)" \ 21 | -e '(defvar *d* (ccldoc:load-document "ccl:doc;internals;internals.ccldoc"))' \ 22 | -e '(ccldoc:output-html *d* "internals.html" :stylesheet "ccl:doc;manual;style.css")' \ 23 | -e '(quit)' 24 | 25 | -------------------------------------------------------------------------------- /doc/internals/backend.ccldoc: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: Lisp; Package: CCL; Coding: utf-8; -*- 2 | 3 | (chapter "Backend" 4 | (para 5 | "Writing " 6 | (code-block "(with-imm-target (other-reg) reg ...)") 7 | " means that we want to assign a register to “reg”, but it can’t be 8 | “other-reg. The vinsn operator type {code :imm} generally means 9 | “can hold a fixnum or other lisp immediate type.” In other words, 10 | such an operand can be placed in an immediate (unboxed) register. 11 | 12 | One can also write " 13 | (code-block "(with-node-target (other-reg) reg ...)") 14 | " if the register has to be able to hold boxed lisp objects (nodes).") 15 | 16 | (para 17 | "The difference between {code with-xxx-temps} and {code 18 | with-xxx-target} is that {code with-xxx-temps} means to find a 19 | register and mark it as being in use, i.e, not available for 20 | allocation as a temporary. 21 | 22 | On the other hand, {code with-xxx-target} means to find a register 23 | that is not marked as being in use, and which does not conflict 24 | with these other specified reigsters. 25 | 26 | As an example, you might want to say “get the vector, index, and 27 | new value into any 3 registers; it doesn't matter which 3, but in 28 | general we want them to be distinct from each other.” While 29 | getting those 3 values into those registers, we might do some 30 | pushing and popping, but we should otherwise be free to allocate 31 | temporaries that conflict with those registers as long as things 32 | wind up in the right places. 33 | 34 | In a few other cases, it’s reasonable to say “mark this as being 35 | in use, so that it isn't allocated as a temporary inside a vinsn.” 36 | That’s useful in some cases, but a bit more dangerous (in that we 37 | can run out of registers through overuse of this fairly easily.)")) 38 | 39 | -------------------------------------------------------------------------------- /doc/internals/internals.ccldoc: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: Lisp; Package: CCL; Coding: utf-8; -*- 2 | 3 | (ccldoc:def-expander CCL () "Clozure CL") 4 | 5 | (document "Clozure CL Internals" 6 | (include-file "assembler.ccldoc" :in-package :ccl) 7 | (include-file "backend.ccldoc" :in-package :ccl) 8 | (include-file "implementation.ccldoc" :in-package :ccl) 9 | (include-file "glossary.ccldoc" :in-package :ccl) 10 | (index-section "Symbol Index")) 11 | -------------------------------------------------------------------------------- /doc/manual/.gitignore: -------------------------------------------------------------------------------- 1 | ccl.html 2 | -------------------------------------------------------------------------------- /doc/manual/Makefile: -------------------------------------------------------------------------------- 1 | # Makefile to format CCL user manual. 2 | # 3 | # The manual is written in a notation called CCLDoc. Its GitHub project 4 | # may be found at https://github.com/Clozure/ccldoc 5 | 6 | # The CCL you want to use. 7 | CCL=ccl 8 | 9 | # Directory where your checkout of CCLDoc is. 10 | # Get CCLDoc with: 11 | # git clone https://github.com/Clozure/ccldoc.git 12 | CCLDOC_ROOT=~/ccl/ccldoc 13 | 14 | ccl.html: *.ccldoc style.css 15 | $(CCL) --batch \ 16 | -e "(require :asdf)" \ 17 | -e "(push \"$(CCLDOC_ROOT)/source/\" asdf:*central-registry*)" \ 18 | -e "(asdf:load-system :ccldoc)" \ 19 | -e '(defvar *d* (ccldoc:load-document "ccl:doc;manual;ccl.ccldoc"))' \ 20 | -e '(ccldoc:output-html *d* "ccl.html" :stylesheet "ccl:doc;manual;style.css")' \ 21 | -e '(quit)' 22 | 23 | -------------------------------------------------------------------------------- /doc/manual/limits.ccldoc: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: Lisp; Package: CCL; Coding: utf-8; -*- 2 | 3 | (chapter "Implementation Limits" 4 | 5 | "Fixnums on 32-bit systems are 30 bits long, and cover the interval 6 | (-536870912, 536870911). Fixnums on 64-bit systems are 61 bits 7 | long, and cover the interval (-1152921504606846976, 1152921504606846975). 8 | 9 | Because 64-bit systems have large fixnums, 10 | {variable internal-time-units-per-second} is 1000000 on 64-bit 11 | systems. It remains 1000 on 32-bit systems. This enables much finer 12 | grained timing on 64-bit systems." 13 | 14 | 15 | ) ;chapter 16 | 17 | 18 | 19 | -------------------------------------------------------------------------------- /doc/manual/style.css: -------------------------------------------------------------------------------- 1 | @import url('https://fonts.googleapis.com/css2?family=Merriweather:ital,wght@0,300;0,400;0,700;0,900;1,300;1,400;1,700;1,900&display=swap'); 2 | 3 | :root { 4 | --toc-width: 22em; 5 | --toc-margin-l: 1em; 6 | } 7 | 8 | h1, h2, h3, h4, h5 { 9 | font-family: system-ui, sans-serif; 10 | font-stretch: condensed; 11 | } 12 | 13 | tt, code, pre { 14 | font-family: ui-monospace, 'Cascadia Code', 'Source Code Pro', Menlo, Consolas, 'DejaVu Sans Mono', monospace; 15 | } 16 | 17 | body { 18 | margin: 0; 19 | font-family: Merriweather, serif; 20 | font-size: medium; 21 | line-height: 1.4; 22 | } 23 | 24 | #contents { 25 | max-width: 50em; 26 | margin: auto; 27 | padding: 0 1em; 28 | } 29 | 30 | #toc { 31 | padding: 0 1em; 32 | } 33 | 34 | @media screen and (min-width: 1025px) { 35 | header { 36 | margin-left: calc(var(--toc-width) + var(--toc-margin-l)); 37 | } 38 | 39 | header h1 { 40 | margin: auto; 41 | max-width: 30em; 42 | } 43 | 44 | #toc { 45 | overflow: auto; 46 | width: var(--toc-width); 47 | height: 100vh; 48 | position: fixed; 49 | top: 0; 50 | left: 0; 51 | bottom: 0; 52 | padding: unset; 53 | margin-left: var(--toc-margin-l); 54 | } 55 | #toc nav ul { 56 | padding-left: 1em; 57 | font-family: system-ui; 58 | font-stretch: condensed; 59 | } 60 | #contents-wrapper { 61 | margin-left: calc(var(--toc-width) + var(--toc-margin-l)); 62 | } 63 | } 64 | 65 | pre > code { 66 | display: block; 67 | overflow: auto; 68 | padding: 0.5em; 69 | border: 1px solid #eee; 70 | line-height: normal; 71 | } 72 | 73 | pre > code > p { 74 | margin: 0; 75 | } 76 | 77 | samp { 78 | background: #fafafa; 79 | } 80 | pre > samp { 81 | display: block; 82 | overflow: auto; 83 | padding: 0.5em; 84 | border: 1px solid #eee; 85 | line-height: normal; 86 | } 87 | 88 | .definition { 89 | margin-bottom: 1.5em; 90 | } 91 | 92 | .definition-kind { 93 | float: right; 94 | } 95 | -------------------------------------------------------------------------------- /doc/release-notes.txt: -------------------------------------------------------------------------------- 1 | Please see http://trac.clozure.com/ccl/wiki/ReleaseNotes/1.3 2 | 3 | -------------------------------------------------------------------------------- /examples/FFI/Allocating-foreign-data-on-the-lisp-heap/Readme.rtf: -------------------------------------------------------------------------------- 1 | {\rtf1\mac\ansicpg10000\cocoartf824\cocoasubrtf410 2 | {\fonttbl\f0\fswiss\fcharset77 Helvetica;\f1\fswiss\fcharset77 Helvetica-Bold;} 3 | {\colortbl;\red255\green255\blue255;} 4 | \margl1440\margr1440\vieww9000\viewh8400\viewkind0 5 | \pard\tx720\tx1440\tx2160\tx2880\tx3600\tx4320\tx5040\tx5760\tx6480\tx7200\tx7920\tx8640\ql\qnatural\pardirnatural 6 | 7 | \f0\fs24 \cf0 Code from the {\field{\*\fldinst{HYPERLINK "http://openmcl.clozure.com/Doc/index.html#Tutorial_003b-Allocating-Foreign-Data-on-the-Lisp-Heap"}}{\fldrslt Allocating Foreign Data on the Lisp Heap Tutorial}} by {\field{\*\fldinst{HYPERLINK "mailto:bsder@allcaps.org"}}{\fldrslt Andrew P. Lentvorski}}\ 8 | \ 9 | 10 | \f1\b Usage 11 | \f0\b0 \ 12 | Run from the REPL with: (load #P"ccl:examples;FFI;Allocating-foreign-data-on-the-lisp-heap;ptrtest.lisp")\ 13 | (if you use a front-end to OpenMCL such as SLIME via emacs, you will only see the output of the Lisp code in the REPL. View the *inferior-lisp* buffer for the output from the C code)\ 14 | \ 15 | 16 | \f1\b Files 17 | \f0\b0 \ 18 | ptrtest.lisp - Lisp code that builds the dynamic library from ptrtest.c, loads it, and calls the functions as described in the tutorial\ 19 | ptrtest.c - C functions to be called\ 20 | ptrtest-compile.sh - Builds the dynamic library from ptrtest.c} -------------------------------------------------------------------------------- /examples/FFI/Allocating-foreign-data-on-the-lisp-heap/ptrtest-compile.sh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | cd $1 3 | echo In directory: `pwd` 4 | gcc -dynamiclib -Wall -o libptrtest.dylib ptrtest.c -install_name ./libptrtest.dylib -------------------------------------------------------------------------------- /examples/FFI/Allocating-foreign-data-on-the-lisp-heap/ptrtest.c: -------------------------------------------------------------------------------- 1 | #include 2 | 3 | void reverse_int_array(int * data, unsigned int dataobjs) 4 | { 5 | int i, t; 6 | 7 | for(i=0; i 2 | 3 | // First set of tuturial functions 4 | 5 | void 6 | void_void_test(void) 7 | { 8 | printf("Entered %s:\n", __FUNCTION__); 9 | printf("Exited %s:\n", __FUNCTION__); 10 | } 11 | 12 | signed char 13 | sc_sc_test(signed char data) 14 | { 15 | printf("Entered %s:\n", __FUNCTION__); 16 | printf("Data In: %d\n", (signed int)data); 17 | printf("Exited %s:\n", __FUNCTION__); 18 | return data; 19 | } 20 | 21 | unsigned char 22 | uc_uc_test(unsigned char data) 23 | { 24 | printf("Entered %s:\n", __FUNCTION__); 25 | printf("Data In: %d\n", (signed int)data); 26 | printf("Exited %s:\n", __FUNCTION__); 27 | return data; 28 | } 29 | 30 | // Second set of tutorial functions 31 | 32 | int 33 | si_si_test(int data) 34 | { 35 | printf("Entered %s:\n", __FUNCTION__); 36 | printf("Data In: %d\n", data); 37 | printf("Exited %s:\n", __FUNCTION__); 38 | return data; 39 | } 40 | 41 | long 42 | sl_sl_test(long data) 43 | { 44 | printf("Entered %s:\n", __FUNCTION__); 45 | printf("Data In: %ld\n", data); 46 | printf("Exited %s:\n", __FUNCTION__); 47 | return data; 48 | } 49 | 50 | long long 51 | sll_sll_test(long long data) 52 | { 53 | printf("Entered %s:\n", __FUNCTION__); 54 | printf("Data In: %lld\n", data); 55 | printf("Exited %s:\n", __FUNCTION__); 56 | return data; 57 | } 58 | 59 | float 60 | f_f_test(float data) 61 | { 62 | printf("Entered %s:\n", __FUNCTION__); 63 | printf("Data In: %e\n", data); 64 | printf("Exited %s:\n", __FUNCTION__); 65 | return data; 66 | } 67 | 68 | double 69 | d_d_test(double data) 70 | { 71 | printf("Entered %s:\n", __FUNCTION__); 72 | printf("Data In: %e\n", data); 73 | printf("Exited %s:\n", __FUNCTION__); 74 | return data; 75 | } 76 | -------------------------------------------------------------------------------- /examples/cocoa/easygui.lisp: -------------------------------------------------------------------------------- 1 | (in-package :ccl) 2 | 3 | (let ((path (or *load-pathname* *loading-file-source-file*))) 4 | (load (merge-pathnames ";easygui;system.lisp" path)) 5 | (load-easygui nil)) -------------------------------------------------------------------------------- /examples/cocoa/easygui/action-targets.lisp: -------------------------------------------------------------------------------- 1 | (in-package :easygui) 2 | 3 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4 | ;;; action/targets 5 | 6 | (defclass generic-easygui-target (ns:ns-object) 7 | ((handler :initarg :handler :reader target-handler) 8 | (shooter :initarg :shooter :reader target-shooter)) 9 | (:metaclass ns:+ns-object)) 10 | 11 | (objc:defmethod (#/activateAction :void) ((self generic-easygui-target)) 12 | (let* ((sender (target-shooter self)) 13 | (cell (and (#/respondsToSelector: sender (@selector #/selectedCell)) 14 | (#/selectedCell sender))) 15 | (responds (and cell (#/respondsToSelector: cell (@selector #/mouseDownFlags)))) 16 | (*modifier-key-pattern* (if responds (#/mouseDownFlags cell) 0))) 17 | (funcall (target-handler self)))) 18 | 19 | (defmethod (setf action) (handler (view view)) 20 | (let ((target (make-instance 'generic-easygui-target 21 | :handler handler :shooter (cocoa-ref view)))) 22 | (#/setTarget: (cocoa-ref view) target) 23 | (#/setAction: (cocoa-ref view) (@selector #/activateAction)))) -------------------------------------------------------------------------------- /examples/cocoa/easygui/example/currency-converter.lisp: -------------------------------------------------------------------------------- 1 | (in-package :easygui-demo) 2 | 3 | (defclass converter-window (window) 4 | () 5 | (:default-initargs :size (point 383 175) 6 | :position (point 125 513) 7 | :title "Currency Converter" 8 | :resizable-p nil 9 | :minimizable-p t)) 10 | 11 | (defmethod initialize-view :after ((cw converter-window)) 12 | (let ((currency-form (make-instance 'form-view 13 | :autosize-cells-p t 14 | :interline-spacing 9.0 15 | :position (point 15 70) 16 | :size (point 353 90))) 17 | (convert-button (make-instance 'push-button-view 18 | :default-button-p t 19 | :text "Convert" 20 | :position (point 247 15))) 21 | (line (make-instance 'box-view 22 | :position (point 15 59) 23 | :size (point 353 2)))) 24 | (setf (action convert-button) 25 | #'(lambda () 26 | (let ((exchange-rate (read-from-string 27 | (entry-text currency-form 1) nil nil)) 28 | (amount (read-from-string (entry-text currency-form 0) 29 | nil nil))) 30 | (when (and (numberp exchange-rate) (numberp amount)) 31 | (setf (entry-text currency-form 2) 32 | (prin1-to-string (* exchange-rate amount))))))) 33 | (setf (editable-p (car (last (add-entries currency-form 34 | "Exchange Rate per $1:" 35 | "Dollars to Convert:" 36 | "Amount in other Currency:")))) 37 | nil) 38 | (add-subviews cw currency-form line convert-button) 39 | (window-show cw))) 40 | 41 | ;(make-instance 'converter-window) -------------------------------------------------------------------------------- /examples/cocoa/easygui/example/view-hierarchy.lisp: -------------------------------------------------------------------------------- 1 | (in-package :easygui-user) 2 | 3 | (defclass view-hierarchy-demo-window (window) 4 | () 5 | (:default-initargs :size (point 480 270) 6 | :position (point 125 513) 7 | :resizable-p nil 8 | :minimizable-p t 9 | :title "View tree demo") 10 | (:documentation "Shows a window with a simple view hierarchy and a button 11 | action that manipulates this hierarchy.")) 12 | 13 | (defmethod initialize-view :after ((w view-hierarchy-demo-window)) 14 | (let ((left-box (make-instance 'box-view 15 | :position (point 17 51) 16 | :size (point 208 199) 17 | :title "Left")) 18 | (right-box (make-instance 'box-view 19 | :position (point 255 51) 20 | :size (point 208 199) 21 | :title "Right")) 22 | (swap-button (make-instance 'push-button-view 23 | :position (point 173 12) 24 | :text "Switch sides")) 25 | (text (make-instance 'static-text-view 26 | :text "Oink!" 27 | :position (point 37 112))) 28 | (leftp t)) 29 | (setf (action swap-button) 30 | (lambda () 31 | (retaining-objects (text) 32 | (cond (leftp 33 | (remove-subviews left-box text) 34 | (add-subviews right-box text)) 35 | (t 36 | (remove-subviews right-box text) 37 | (add-subviews left-box text)))) 38 | (setf leftp (not leftp)))) 39 | (add-subviews w left-box right-box swap-button) 40 | (add-subviews left-box text) 41 | (window-show w))) 42 | 43 | ;;; (make-instance 'view-hierarchy-demo-window) -------------------------------------------------------------------------------- /examples/cocoa/easygui/rgb.lisp: -------------------------------------------------------------------------------- 1 | (in-package :easygui) 2 | 3 | ; -------------------------------------------------------------------------------- 4 | ; This provides for Clozure CL some RGB functions to match Allegro CL. 5 | ; Contributed by AWSC (arthur.cater@ucd.ie) March 2009. 6 | ; Permission to disseminate, use and modify is granted. 7 | ; -------------------------------------------------------------------------------- 8 | 9 | (defun make-rgb (&key (red 0) (green 0) (blue 0) (opacity 1.0)) 10 | (assert (typep red '(integer 0 255)) (red) 11 | "Value of RED component for make-rgb must be an integer 0-255 inclusive") 12 | (assert (typep green '(integer 0 255)) (green) 13 | "Value of GREEN component for make-rgb must be an integer 0-255 inclusive") 14 | (assert (typep blue '(integer 0 255)) (blue) 15 | "Value of BLUE component for make-rgb must be an integer 0-255 inclusive") 16 | (assert (typep opacity '(single-float 0.0 1.0)) (opacity) 17 | "Value of OPACITY component for make-rgb must be a single-float 0.0-1.0 inclusive") 18 | (#/retain 19 | (#/colorWithCalibratedRed:green:blue:alpha: 20 | ns:ns-color 21 | (/ red 255.0) 22 | (/ green 255.0) 23 | (/ blue 255.0) 24 | opacity))) 25 | 26 | (defun rgb-red (color) (round (* 255 (#/redComponent color)))) 27 | 28 | (defun rgb-green (color) (round (* 255 (#/greenComponent color)))) 29 | 30 | (defun rgb-blue (color) (round (* 255 (#/blueComponent color)))) 31 | 32 | (defun rgb-opacity (color) (#/alphaComponent color)) 33 | 34 | -------------------------------------------------------------------------------- /examples/cocoa/easygui/system.lisp: -------------------------------------------------------------------------------- 1 | (in-package :ccl) 2 | 3 | (defparameter *easygui-pathname* (or *load-pathname* *loading-file-source-file*)) 4 | 5 | (defvar *easygui-files* 6 | '("package" 7 | "new-cocoa-bindings" 8 | "events" 9 | "rgb" 10 | "views" 11 | "action-targets" 12 | "dialogs")) 13 | 14 | (defvar *easygui-examples* 15 | '("tiny" 16 | "currency-converter" 17 | "view-hierarchy")) 18 | 19 | (defun load-easygui (&optional (force-compile t)) 20 | (with-compilation-unit () 21 | (setq force-compile (load-ide-files *easygui-files* *easygui-pathname* force-compile)) 22 | (setq force-compile (load-ide-files *easygui-examples* (merge-pathnames ";example;" *easygui-pathname*) force-compile)) 23 | (push :easygui *features*)) 24 | force-compile) 25 | -------------------------------------------------------------------------------- /examples/cocoa/interface-databases/HOWTO_files/images/bosco.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/examples/cocoa/interface-databases/HOWTO_files/images/bosco.jpg -------------------------------------------------------------------------------- /examples/cocoa/interface-databases/HOWTO_files/stylesheets/styles.css: -------------------------------------------------------------------------------- 1 | body { 2 | background-color: white; 3 | font-family: "Helvetica Neue", Arial, Helvetica, Geneva, sans-serif; 4 | } 5 | 6 | .title { 7 | text-align: center; 8 | font-size: 16pt; 9 | } 10 | 11 | .subtitle { 12 | font-size: medium; 13 | font-weight: bold; 14 | text-align: center; 15 | } 16 | 17 | .byline { 18 | text-align: center; 19 | font-weight: bold; 20 | font-size: small; 21 | } 22 | 23 | .section-head { 24 | padding-top: 2em; 25 | padding-left: 1em; 26 | } 27 | 28 | .body-text { 29 | font: 12pt Georgia, "Times New Roman", Times, serif; 30 | margin-left: 4em; 31 | margin-right: 4em; 32 | text-indent: 3em; 33 | } 34 | 35 | .note { 36 | font: 12pt Georgia, "Times New Roman", Times, serif; 37 | margin-left: 6em; 38 | margin-right: 6em; 39 | text-indent: 0em; 40 | } 41 | 42 | .inline-image { 43 | text-align: center; 44 | } 45 | 46 | .nav { 47 | text-align: center; 48 | font-size: large; 49 | font-weight: bold; 50 | padding-top: 4em; 51 | } 52 | 53 | li, pre { 54 | text-indent: 0; 55 | } -------------------------------------------------------------------------------- /examples/cocoa/qtvidcapture/QTVidCapture.nib/classes.nib: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | IBClasses 6 | 7 | 8 | ACTIONS 9 | 10 | startRecording 11 | id 12 | stopRecording 13 | id 14 | 15 | CLASS 16 | MyRecorderController 17 | LANGUAGE 18 | ObjC 19 | OUTLETS 20 | 21 | mCaptureView 22 | QTCaptureView 23 | 24 | SUPERCLASS 25 | NSObject 26 | 27 | 28 | IBVersion 29 | 1 30 | 31 | 32 | -------------------------------------------------------------------------------- /examples/cocoa/qtvidcapture/QTVidCapture.nib/info.nib: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | IBFramework Version 6 | 677 7 | IBOldestOS 8 | 5 9 | IBOpenObjects 10 | 11 | 21 12 | 13 | IBSystem Version 14 | 10A354 15 | targetFramework 16 | IBCocoaFramework 17 | 18 | 19 | -------------------------------------------------------------------------------- /examples/cocoa/qtvidcapture/QTVidCapture.nib/keyedobjects.nib: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/examples/cocoa/qtvidcapture/QTVidCapture.nib/keyedobjects.nib -------------------------------------------------------------------------------- /examples/cocoa/ui-elements/HOWTO_files/images/bosco.jpg: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/examples/cocoa/ui-elements/HOWTO_files/images/bosco.jpg -------------------------------------------------------------------------------- /examples/cocoa/ui-elements/HOWTO_files/stylesheets/styles.css: -------------------------------------------------------------------------------- 1 | body { 2 | background-color: white; 3 | font-family: "Helvetica Neue", Arial, Helvetica, Geneva, sans-serif; 4 | } 5 | 6 | .title { 7 | text-align: center; 8 | font-size: 16pt; 9 | } 10 | 11 | .subtitle { 12 | font-size: medium; 13 | font-weight: bold; 14 | text-align: center; 15 | } 16 | 17 | .byline { 18 | text-align: center; 19 | font-weight: bold; 20 | font-size: small; 21 | } 22 | 23 | .section-head { 24 | padding-top: 2em; 25 | padding-left: 1em; 26 | } 27 | 28 | .body-text { 29 | font: 12pt Georgia, "Times New Roman", Times, serif; 30 | margin-left: 4em; 31 | margin-right: 4em; 32 | text-indent: 3em; 33 | } 34 | 35 | .note { 36 | font: 12pt Georgia, "Times New Roman", Times, serif; 37 | margin-left: 6em; 38 | margin-right: 6em; 39 | text-indent: 0em; 40 | } 41 | 42 | .inline-image { 43 | text-align: center; 44 | } 45 | 46 | .nav { 47 | text-align: center; 48 | font-size: large; 49 | font-weight: bold; 50 | padding-top: 4em; 51 | } 52 | 53 | li, pre { 54 | text-indent: 0; 55 | } -------------------------------------------------------------------------------- /examples/code-cover-test/cl-ppcre-tests.lisp: -------------------------------------------------------------------------------- 1 | ;; -*- Mode: Lisp; tab-width: 2; indent-tabs-mode: nil -*- 2 | 3 | ;; Methods for compiling and running CL-PPCRE unit tests with code coverage analysis 4 | 5 | (in-package :code-cover-test) 6 | 7 | (require :cl-ppcre-test) 8 | 9 | ;; Compiling CL-PPCRE unit tests with code coverage analysis (maybe) enabled 10 | 11 | (defmethod asdf:perform :around ((op asdf:compile-op) (system (eql (asdf:find-system :cl-ppcre)))) 12 | (with-code-coverage-compile () 13 | (call-next-method))) 14 | 15 | (defmethod asdf:perform :around ((op asdf:compile-op) (system (eql (asdf:find-system :cl-ppcre-test)))) 16 | (with-code-coverage-compile () 17 | (call-next-method))) 18 | 19 | ;; Running unit tests with code coverage analysis (maybe) enabled 20 | 21 | (defclass cl-ppcre-tests (code-cover-test) 22 | ((verbose-p :initform nil :initarg :verbose-p)) 23 | (:default-initargs :systems '("cl-ppcre-test" "cl-ppcre")) 24 | ) 25 | 26 | (defmethod do-tests ((test cl-ppcre-tests) &rest args) 27 | (declare (ignore args)) 28 | ;; see cl-ppcre-test/test/tests.lisp 29 | (with-slots (verbose-p) test 30 | (do-test "perl-test" 31 | (cl-ppcre-test::perl-test :verbose verbose-p)) 32 | (do-test "test-optimized-test-functions" 33 | (cl-ppcre-test::test-optimized-test-functions :verbose verbose-p)) 34 | (dotimes (n 10) 35 | (do-test (format nil "simple-tests-~d" n) 36 | (cl-ppcre-test::simple-tests :verbose verbose-p))))) 37 | -------------------------------------------------------------------------------- /examples/code-cover-test/code-cover-test-server.asd: -------------------------------------------------------------------------------- 1 | ;; -*- Mode:Lisp; tab-width:2; indent-tabs-mode:nil -*- 2 | 3 | (defpackage code-cover-test-server.system 4 | (:use #:cl #:asdf)) 5 | 6 | (in-package code-cover-test-server.system) 7 | 8 | (defpackage code-cover-test-server 9 | (:use #:cl) 10 | (:import-from #:code-cover-test #:index-file-path #:output-path) 11 | (:export #:init-server 12 | #:start-server 13 | #:stop-server)) 14 | 15 | (defsystem code-cover-test-server 16 | :depends-on ( code-cover-test hunchentoot ) 17 | :components 18 | ((:file "code-cover-test-server"))) 19 | 20 | -------------------------------------------------------------------------------- /examples/code-cover-test/code-cover-test.asd: -------------------------------------------------------------------------------- 1 | ;; -*- Mode:Lisp; tab-width:2; indent-tabs-mode:nil -*- 2 | 3 | (defpackage code-cover-test.system 4 | (:use #:cl #:asdf)) 5 | 6 | (in-package code-cover-test.system) 7 | 8 | (defpackage code-cover-test 9 | (:use #:cl) 10 | (:export #:init-test-code-coverage 11 | #:run-all-tests-with-code-coverage 12 | #:report-code-coverage-test)) 13 | 14 | (defsystem code-cover-test 15 | :components 16 | ((:file "compile-with-code-coverage") 17 | (:file "code-cover-test" :depends-on ("compile-with-code-coverage")))) 18 | 19 | (defsystem code-cover-tests 20 | :depends-on (code-cover-test cl-ppcre cl-ppcre-test) 21 | :components 22 | ((:file "cl-ppcre-tests"))) 23 | -------------------------------------------------------------------------------- /examples/code-cover-test/compile-with-code-coverage.lisp: -------------------------------------------------------------------------------- 1 | ;; -*- Mode: Lisp; tab-width: 2; indent-tabs-mode: nil -*- 2 | 3 | ;; Control over whether to compile with code coverage analysis enabled 4 | 5 | ;; TODO: fall back to cover.lisp if not using CCL 6 | 7 | (in-package :code-cover-test) 8 | 9 | (defvar *compile-code-coverage-default-p* nil 10 | "Set this to true to ASDF compile all systems with code coverage analysis") 11 | 12 | (defvar *compile-code-coverage-p* nil 13 | "Flag indicates whether currently compiling with code coverage analysis") 14 | 15 | (defmacro with-code-coverage-compile ((&optional (flag '*compile-code-coverage-p*)) &body body) 16 | `(let ((*compile-code-coverage-p* ,flag) 17 | #+ccl 18 | (ccl:*compile-code-coverage* *compile-code-coverage-p*) 19 | ) 20 | #-ccl 21 | (when *compile-code-coverage-p* 22 | (warn "Code coverage compile is only implemented for CCL") 23 | (setq *compile-code-coverage-p* nil)) 24 | ;; Continue 25 | ,@body)) 26 | 27 | ;; ASDF compile methods - these are for all systems and components 28 | 29 | (defmethod asdf:perform :around ((op asdf:compile-op) (system asdf:system)) 30 | (with-code-coverage-compile (*compile-code-coverage-default-p*) 31 | (call-next-method))) 32 | 33 | (defmethod asdf:perform :around ((op asdf:compile-op) (component t)) 34 | (declare (ignore component)) 35 | (if asdf:*asdf-verbose* 36 | (warn "Compiling ~a with code coverage ~@?" 37 | component "~:[off~;on~]" 38 | #+ccl 39 | ccl:*compile-code-coverage* 40 | #-cll 41 | *compile-code-coverage-p*)) 42 | (call-next-method)) 43 | -------------------------------------------------------------------------------- /examples/code-cover-test/package.lisp: -------------------------------------------------------------------------------- 1 | ;; -*- Mode:Lisp; tab-width:2; indent-tabs-mode:nil -*- 2 | 3 | (defpackage code-cover-test 4 | (:use #:cl) 5 | (:import-from #:cl-ppcre-test "PERL-TEST" "TEST-OPTIMIZED-TEST-FUNCTIONS" "SIMPLE-TESTS") 6 | (:export 7 | "INIT-CODE-COVERAGE" 8 | "RUN-ALL-TESTS-WITH-CODE-COVERAGE" 9 | "REPORT-CODE-COVERAGE-TEST" 10 | "INIT-CODE-COVERAGE-TEST-SERVER" "START-CODE-COVERAGE-TEST-SERVER" "STOP-CODE-COVERAGE-TEST-SERVER") 11 | ) 12 | 13 | -------------------------------------------------------------------------------- /examples/jfli/com/richhickey/jfli/LispInvocationHandler.java: -------------------------------------------------------------------------------- 1 | package com.richhickey.jfli; 2 | 3 | // Copyright (c) Rich Hickey. All rights reserved. 4 | // The use and distribution terms for this software are covered by the 5 | // Common Public License 1.0 (http://opensource.org/licenses/cpl.php) 6 | // which can be found in the file CPL.TXT at the root of this distribution. 7 | // By using this software in any fashion, you are agreeing to be bound by 8 | // the terms of this license. 9 | // You must not remove this notice, or any other, from this software. 10 | 11 | import java.lang.*; 12 | import java.lang.reflect.*; 13 | 14 | public class LispInvocationHandler implements InvocationHandler 15 | { 16 | public native Object invoke(Object proxy,Method method, Object[] args) throws Throwable; 17 | } 18 | -------------------------------------------------------------------------------- /examples/jfli/docs/bullet.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/examples/jfli/docs/bullet.gif -------------------------------------------------------------------------------- /examples/jfli/docs/bullet2.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/examples/jfli/docs/bullet2.gif -------------------------------------------------------------------------------- /examples/jfli/docs/jfli_bkgrnd.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/examples/jfli/docs/jfli_bkgrnd.gif -------------------------------------------------------------------------------- /examples/jfli/docs/jfli_new.gif: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/examples/jfli/docs/jfli_new.gif -------------------------------------------------------------------------------- /examples/jfli/examples/swtdemo.lisp: -------------------------------------------------------------------------------- 1 | ;Just load this from LispWorks menu 2 | ;note works on Windows, some issues on OS X due to windowing conflict w/IDE 3 | (require "JNI") 4 | (load "ccl:examples;jfli;jfli") 5 | (use-package :jfli) 6 | (create-jvm 7 | "-Djava.class.path=/cygwin/home/gb/swt/swt.jar;/;/cygwin/usr/local/src/ccl-dev/examples/jfli/jfli.jar" 8 | ) 9 | (enable-java-proxies) 10 | 11 | 12 | 13 | (def-java-class "org.eclipse.swt.widgets.Display") 14 | (def-java-class "org.eclipse.swt.widgets.Button") 15 | (def-java-class "org.eclipse.swt.widgets.Shell") 16 | (def-java-class "org.eclipse.swt.widgets.Listener") 17 | (def-java-class "org.eclipse.swt.SWT") 18 | 19 | (use-package "org.eclipse.swt") 20 | (use-package "org.eclipse.swt.widgets") 21 | 22 | 23 | (defun swt-demo () 24 | (let* ((display (new display.)) 25 | (shell (new shell. display 26 | :gettext "Using SWT from Lisp" 27 | (.setsize 300 200) 28 | (.setlocation 100 100))) 29 | (button (new (button. this) shell *SWT.CENTER* 30 | :gettext "Call Lisp" 31 | (.addlistener *swt.selection* 32 | (new-proxy (listener. 33 | (handleevent (event) 34 | (declare (ignore event)) 35 | (setf (button.gettext this) 36 | (format nil "~A ~A" 37 | (lisp-implementation-type) 38 | (lisp-implementation-version))) 39 | nil)))) 40 | (.setsize 200 100) 41 | (.setlocation 40 40)))) 42 | (declare (ignore button)) 43 | (shell.open shell) 44 | (do () 45 | ((shell.isdisposed shell)) 46 | (unless (display.readanddispatch display) 47 | (display.sleep display))) 48 | (display.dispose display))) 49 | 50 | (mp:process-run-function "swt-proc" '() #'swt-demo) 51 | 52 | -------------------------------------------------------------------------------- /examples/jfli/jfli.jar: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/examples/jfli/jfli.jar -------------------------------------------------------------------------------- /examples/rubix/loader.lisp: -------------------------------------------------------------------------------- 1 | (in-package :cl-user) 2 | 3 | (require "COCOA") 4 | 5 | (let* ((containing-dir (make-pathname :directory (pathname-directory *load-truename*) :defaults nil))) 6 | (flet ((load-relative (path) 7 | (load (merge-pathnames path containing-dir)))) 8 | (load-relative "opengl.lisp") 9 | (load-relative "vectors.lisp") 10 | (load-relative "lights.lisp") 11 | (load-relative "blocks.lisp") 12 | (load-relative "rubix.lisp"))) 13 | 14 | 15 | ; (gui::execute-in-gui #'run-rubix-demo) 16 | -------------------------------------------------------------------------------- /level-0/ARM/arm-io.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: Lisp; Package: CCL; -*- 2 | ;;; 3 | ;;; Copyright 2010 Clozure Associates 4 | ;;; 5 | ;;; Licensed under the Apache License, Version 2.0 (the "License"); 6 | ;;; you may not use this file except in compliance with the License. 7 | ;;; You may obtain a copy of the License at 8 | ;;; 9 | ;;; http://www.apache.org/licenses/LICENSE-2.0 10 | ;;; 11 | ;;; Unless required by applicable law or agreed to in writing, software 12 | ;;; distributed under the License is distributed on an "AS IS" BASIS, 13 | ;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | ;;; See the License for the specific language governing permissions and 15 | ;;; limitations under the License. 16 | 17 | 18 | 19 | (in-package "CCL") 20 | 21 | ;;; not very smart yet 22 | 23 | (defarmlapfunction %get-errno () 24 | (mov temp0 (:$ 0)) 25 | (ldr imm1 (:@ rcontext (:$ arm::tcr.errno-loc))) 26 | (ldr imm0 (:@ imm1 (:$ 0))) 27 | (str temp0 (:@ imm1 (:$ 0))) 28 | (rsb imm0 imm0 (:$ 0)) 29 | (box-fixnum arg_z imm0) 30 | (bx lr)) 31 | 32 | ; end 33 | -------------------------------------------------------------------------------- /level-0/PPC/ppc-io.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: Lisp; Package: CCL; -*- 2 | ;;; 3 | ;;; Copyright 1994-2009 Clozure Associates 4 | ;;; 5 | ;;; Licensed under the Apache License, Version 2.0 (the "License"); 6 | ;;; you may not use this file except in compliance with the License. 7 | ;;; You may obtain a copy of the License at 8 | ;;; 9 | ;;; http://www.apache.org/licenses/LICENSE-2.0 10 | ;;; 11 | ;;; Unless required by applicable law or agreed to in writing, software 12 | ;;; distributed under the License is distributed on an "AS IS" BASIS, 13 | ;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | ;;; See the License for the specific language governing permissions and 15 | ;;; limitations under the License. 16 | 17 | 18 | 19 | (in-package "CCL") 20 | 21 | ;;; not very smart yet 22 | 23 | (defppclapfunction %get-errno () 24 | (ldr imm1 target::tcr.errno-loc target::rcontext) 25 | (lwz imm0 0 imm1) 26 | (stw rzero 0 imm1) 27 | (neg imm0 imm0) 28 | (box-fixnum arg_z imm0) 29 | (blr)) 30 | 31 | ; end 32 | -------------------------------------------------------------------------------- /level-0/X86/x86-io.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode: Lisp; Package: CCL; -*- 2 | ;;; 3 | ;;; Copyright 1994-2009 Clozure Associates 4 | ;;; 5 | ;;; Licensed under the Apache License, Version 2.0 (the "License"); 6 | ;;; you may not use this file except in compliance with the License. 7 | ;;; You may obtain a copy of the License at 8 | ;;; 9 | ;;; http://www.apache.org/licenses/LICENSE-2.0 10 | ;;; 11 | ;;; Unless required by applicable law or agreed to in writing, software 12 | ;;; distributed under the License is distributed on an "AS IS" BASIS, 13 | ;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | ;;; See the License for the specific language governing permissions and 15 | ;;; limitations under the License. 16 | 17 | 18 | 19 | (in-package "CCL") 20 | 21 | ;;; not very smart yet 22 | 23 | #+x8664-target 24 | (defx86lapfunction %get-errno () 25 | (movq (:rcontext x8664::tcr.errno-loc) (% imm1)) 26 | (movslq (@ (% imm1)) (% imm0)) 27 | (movss (% fpzero) (@ (% imm1))) 28 | (negq (% imm0)) 29 | (box-fixnum imm0 arg_z) 30 | (single-value-return)) 31 | 32 | #+x8632-target 33 | (defx8632lapfunction %get-errno () 34 | #+windows-target 35 | (progn 36 | (movl (:rcontext x8632::tcr.aux) (% imm0)) 37 | (movl (@ x8632::tcr-aux.errno-loc (% imm0)) (% imm0))) 38 | #-windows-target 39 | (movl (:rcontext x8632::tcr.errno-loc) (% imm0)) 40 | (movl (@ (% imm0)) (% imm0)) 41 | (neg (% imm0)) 42 | (box-fixnum imm0 arg_z) 43 | #+windows-target 44 | (progn 45 | (movl (:rcontext x8632::tcr.aux) (% imm0)) 46 | (movl (@ x8632::tcr-aux.errno-loc (% imm0)) (% imm0))) 47 | #-windows-target 48 | (movl (:rcontext x8632::tcr.errno-loc) (% imm0)) 49 | (movss (% fpzero) (@ (% imm0))) 50 | (single-value-return)) 51 | 52 | -------------------------------------------------------------------------------- /level-0/l0-complex.lisp: -------------------------------------------------------------------------------- 1 | ;;;-*- Mode: Lisp; Package: CCL -*- 2 | ;;; 3 | ;;; Copyright 1994-2009 Clozure Associates 4 | ;;; 5 | ;;; Licensed under the Apache License, Version 2.0 (the "License"); 6 | ;;; you may not use this file except in compliance with the License. 7 | ;;; You may obtain a copy of the License at 8 | ;;; 9 | ;;; http://www.apache.org/licenses/LICENSE-2.0 10 | ;;; 11 | ;;; Unless required by applicable law or agreed to in writing, software 12 | ;;; distributed under the License is distributed on an "AS IS" BASIS, 13 | ;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | ;;; See the License for the specific language governing permissions and 15 | ;;; limitations under the License. 16 | 17 | (in-package "CCL") 18 | 19 | (eval-when (:compile-toplevel) 20 | (require "NUMBER-MACROS")) 21 | 22 | (defun coerce-to-complex-type (num type) 23 | (cond ((complexp num) 24 | (let ((real (%realpart num)) 25 | (imag (%imagpart num))) 26 | (if (and (typep real type) 27 | (typep imag type)) 28 | num 29 | (complex (coerce real type) 30 | (coerce imag type))))) 31 | (t (complex (coerce num type))))) 32 | 33 | ;;; end of l0-complex.lisp 34 | -------------------------------------------------------------------------------- /level-1/arm-callback-support.lisp: -------------------------------------------------------------------------------- 1 | ;;;-*-Mode: LISP; Package: CCL -*- 2 | ;;; 3 | ;;; Copyright 2010 Clozure Associates 4 | ;;; 5 | ;;; Licensed under the Apache License, Version 2.0 (the "License"); 6 | ;;; you may not use this file except in compliance with the License. 7 | ;;; You may obtain a copy of the License at 8 | ;;; 9 | ;;; http://www.apache.org/licenses/LICENSE-2.0 10 | ;;; 11 | ;;; Unless required by applicable law or agreed to in writing, software 12 | ;;; distributed under the License is distributed on an "AS IS" BASIS, 13 | ;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | ;;; See the License for the specific language governing permissions and 15 | ;;; limitations under the License. 16 | 17 | (in-package "CCL") 18 | 19 | (defun make-callback-trampoline (index &optional info) 20 | (declare (ignore info)) 21 | (let* ((p (%allocate-callback-pointer 16))) 22 | (macrolet ((arm-lap-word (instruction-form) 23 | (uvref (uvref (compile nil `(lambda (&lap 0) (arm-lap-function () ((?? 0)) ,instruction-form))) 1) 0))) 24 | (setf (%get-unsigned-long p 0) 25 | (dpb (ldb (byte 8 0) index) 26 | (byte 8 0) 27 | (arm-lap-word (mov r12 (:$ ??)))) 28 | (%get-unsigned-long p 4) 29 | (dpb (ldb (byte 8 8) index) 30 | (byte 8 0) 31 | (dpb 12 (byte 4 8) 32 | (arm-lap-word (orr r12 r12 (:$ ??))))) 33 | (%get-unsigned-long p 8) 34 | (arm-lap-word (ldr pc (:@ pc (:$ -4)))) 35 | (%get-unsigned-long p 12) 36 | (%lookup-subprim-address #.(subprim-name->offset '.SPeabi-callback))) 37 | (ff-call (%kernel-import #.arm::kernel-import-makedataexecutable) 38 | :address p 39 | :unsigned-fullword 16 40 | :void) 41 | p))) 42 | 43 | -------------------------------------------------------------------------------- /level-1/l1-boot-3.lisp: -------------------------------------------------------------------------------- 1 | ;;;-*- Mode: Lisp; Package: CCL -*- 2 | ;;; 3 | ;;; Copyright 1994-2009 Clozure Associates 4 | ;;; 5 | ;;; Licensed under the Apache License, Version 2.0 (the "License"); 6 | ;;; you may not use this file except in compliance with the License. 7 | ;;; You may obtain a copy of the License at 8 | ;;; 9 | ;;; http://www.apache.org/licenses/LICENSE-2.0 10 | ;;; 11 | ;;; Unless required by applicable law or agreed to in writing, software 12 | ;;; distributed under the License is distributed on an "AS IS" BASIS, 13 | ;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | ;;; See the License for the specific language governing permissions and 15 | ;;; limitations under the License. 16 | 17 | ;;; l1-boot-3.lisp 18 | ;;; Third part of l1-boot 19 | 20 | (in-package "CCL") 21 | 22 | ;;; Register Emacs-friendly aliases for some character encodings. 23 | ;;; This could go on forever; try to recognize at least some common 24 | ;;; cases. (The precise set of encoding/coding-system names supported 25 | ;;; by Emacs likely depends on Emacs version, loaded Emacs packages, etc.) 26 | 27 | (dotimes (i 16) 28 | (let* ((key (find-symbol (format nil "LATIN~d" i) :keyword)) 29 | (existing (and key (lookup-character-encoding key)))) 30 | (when existing 31 | (define-character-encoding-alias (intern (format nil "LATIN-~d" i) :keyword) existing) 32 | (define-character-encoding-alias (intern (format nil "ISO-LATIN-~d" i) :keyword) existing)))) 33 | 34 | (define-character-encoding-alias :mule-utf-8 :utf-8) 35 | 36 | (set-pathname-encoding-name :utf-8) 37 | 38 | (catch :toplevel 39 | (or (find-package "COMMON-LISP-USER") 40 | (make-package "COMMON-LISP-USER" :use '("COMMON-LISP" "CCL") :NICKNAMES '("CL-USER"))) 41 | ) 42 | 43 | (set-periodic-task-interval .33) 44 | (setq cmain xcmain) 45 | (setq %err-disp %xerr-disp) 46 | 47 | ;;;end of l1-boot-3.lisp 48 | 49 | -------------------------------------------------------------------------------- /level-1/version.lisp: -------------------------------------------------------------------------------- 1 | ;;;-*-Mode: LISP; Package: CCL -*- 2 | ;;; 3 | ;;; Copyright 1994-2009 Clozure Associates 4 | ;;; 5 | ;;; Licensed under the Apache License, Version 2.0 (the "License"); 6 | ;;; you may not use this file except in compliance with the License. 7 | ;;; You may obtain a copy of the License at 8 | ;;; 9 | ;;; http://www.apache.org/licenses/LICENSE-2.0 10 | ;;; 11 | ;;; Unless required by applicable law or agreed to in writing, software 12 | ;;; distributed under the License is distributed on an "AS IS" BASIS, 13 | ;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | ;;; See the License for the specific language governing permissions and 15 | ;;; limitations under the License. 16 | 17 | (in-package "CCL") 18 | 19 | (defparameter *openmcl-major-version* 1) 20 | (defparameter *openmcl-minor-version* 13) 21 | (defparameter *openmcl-revision* nil) 22 | ;;; May be set by xload-level-0 23 | (defvar *openmcl-svn-revision* nil) 24 | (defparameter *openmcl-dev-level* nil) 25 | 26 | (defparameter *openmcl-version* (format nil "~d.~d~@[.~a~] ~@[(~a)~] ~~A" 27 | *openmcl-major-version* 28 | *openmcl-minor-version* 29 | (unless (null *openmcl-revision*) 30 | *openmcl-revision*) 31 | (if (and (typep *openmcl-svn-revision* 'string) 32 | (> (length *openmcl-svn-revision*) 0)) 33 | *openmcl-svn-revision*))) 34 | 35 | ;;; end 36 | -------------------------------------------------------------------------------- /lib/armenv.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Mode:Lisp; Package:CCL; -*- 2 | ;;; 3 | ;;; Copyright 2010 Clozure Associates 4 | ;;; 5 | ;;; Licensed under the Apache License, Version 2.0 (the "License"); 6 | ;;; you may not use this file except in compliance with the License. 7 | ;;; You may obtain a copy of the License at 8 | ;;; 9 | ;;; http://www.apache.org/licenses/LICENSE-2.0 10 | ;;; 11 | ;;; Unless required by applicable law or agreed to in writing, software 12 | ;;; distributed under the License is distributed on an "AS IS" BASIS, 13 | ;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | ;;; See the License for the specific language governing permissions and 15 | ;;; limitations under the License. 16 | 17 | (in-package "CCL") 18 | 19 | (defconstant $numarmsaveregs 0) 20 | (defconstant $numarmargregs 3) 21 | 22 | 23 | (defconstant arm-nonvolatile-registers-mask 24 | 0) 25 | 26 | (defconstant arm-arg-registers-mask 27 | (logior (ash 1 arm::arg_z) 28 | (ash 1 arm::arg_y) 29 | (ash 1 arm::arg_x))) 30 | 31 | (defconstant arm-temp-registers-mask 32 | (logior (ash 1 arm::temp0) 33 | (ash 1 arm::temp1) 34 | (ash 1 arm::temp2))) 35 | 36 | 37 | (defconstant arm-tagged-registers-mask 38 | (logior arm-temp-registers-mask 39 | arm-arg-registers-mask 40 | arm-nonvolatile-registers-mask)) 41 | 42 | 43 | 44 | (defconstant arm-temp-node-regs 45 | (make-mask arm::temp0 46 | arm::temp1 47 | arm::temp2 48 | arm::arg_x 49 | arm::arg_y 50 | arm::arg_z)) 51 | 52 | (defconstant arm-nonvolatile-node-regs 53 | 0) 54 | 55 | 56 | (defconstant arm-node-regs (logior arm-temp-node-regs arm-nonvolatile-node-regs)) 57 | 58 | (defconstant arm-imm-regs (make-mask 59 | arm::imm0 60 | arm::imm1 61 | arm::imm2)) 62 | 63 | (defconstant arm-temp-fp-regs (1- (ash 1 28))) 64 | 65 | (defconstant arm-cr-fields (make-mask 0)) 66 | 67 | 68 | 69 | 70 | 71 | 72 | (defconstant $undo-arm-c-frame 16) 73 | 74 | 75 | (ccl::provide "ARMENV") 76 | -------------------------------------------------------------------------------- /lib/distrib-inits.lisp: -------------------------------------------------------------------------------- 1 | ; -*- Mode:Lisp; Package:CCL; -*- 2 | ;;; 3 | ;;; Copyright 1994-2009 Clozure Associates 4 | ;;; 5 | ;;; Licensed under the Apache License, Version 2.0 (the "License"); 6 | ;;; you may not use this file except in compliance with the License. 7 | ;;; You may obtain a copy of the License at 8 | ;;; 9 | ;;; http://www.apache.org/licenses/LICENSE-2.0 10 | ;;; 11 | ;;; Unless required by applicable law or agreed to in writing, software 12 | ;;; distributed under the License is distributed on an "AS IS" BASIS, 13 | ;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | ;;; See the License for the specific language governing permissions and 15 | ;;; limitations under the License. 16 | 17 | ;; distrib-inits.lisp 18 | 19 | ; Things that are in the development environment that need to be 20 | ; added to the distribution environment. 21 | 22 | ; This needs to be compiled after everything is loaded. 23 | 24 | (in-package "CCL") 25 | 26 | ; *def-accessor-types* is used by the inspector to name slots in uvectors 27 | (dolist (cell '#.*def-accessor-types*) 28 | (add-accessor-types (list (car cell)) (cdr cell))) 29 | -------------------------------------------------------------------------------- /lib/ffi-darwinx8632.lisp: -------------------------------------------------------------------------------- 1 | ;;; 2 | ;;; Copyright 2009 Clozure Associates 3 | ;;; 4 | ;;; Licensed under the Apache License, Version 2.0 (the "License"); 5 | ;;; you may not use this file except in compliance with the License. 6 | ;;; You may obtain a copy of the License at 7 | ;;; 8 | ;;; http://www.apache.org/licenses/LICENSE-2.0 9 | ;;; 10 | ;;; Unless required by applicable law or agreed to in writing, software 11 | ;;; distributed under the License is distributed on an "AS IS" BASIS, 12 | ;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | ;;; See the License for the specific language governing permissions and 14 | ;;; limitations under the License. 15 | 16 | (in-package "CCL") 17 | 18 | ;;; Some small structures are returned in EAX and EDX. Otherwise, 19 | ;;; return values are placed at the address specified by the caller. 20 | (defun x86-darwin32::record-type-returns-structure-as-first-arg (rtype) 21 | (when (and rtype 22 | (not (typep rtype 'unsigned-byte)) 23 | (not (member rtype *foreign-representation-type-keywords* 24 | :test #'eq))) 25 | (let* ((ftype (if (typep rtype 'foreign-type) 26 | rtype 27 | (parse-foreign-type rtype))) 28 | (nbits (ensure-foreign-type-bits ftype))) 29 | (not (member nbits '(8 16 32 64)))))) 30 | 31 | ;;; We don't support the __m64, __m128, __m128d, and __m128i types. 32 | (defun x86-darwin32::expand-ff-call (callform args &key (arg-coerce #'null-coerce-foreign-arg) (result-coerce #'null-coerce-foreign-result)) 33 | (x8632::expand-ff-call callform args :arg-coerce arg-coerce :result-coerce result-coerce)) 34 | 35 | (defun x86-darwin32::generate-callback-bindings (stack-ptr fp-args-ptr argvars argspecs result-spec struct-result-name) 36 | (x8632::generate-callback-bindings stack-ptr fp-args-ptr argvars argspecs result-spec struct-result-name)) 37 | 38 | (defun x86-darwin32::generate-callback-return-value (stack-ptr fp-args-ptr result return-type struct-return-arg) 39 | (x8632::generate-callback-return-value stack-ptr fp-args-ptr result return-type struct-return-arg)) 40 | -------------------------------------------------------------------------------- /lib/ffi-darwinx8664.lisp: -------------------------------------------------------------------------------- 1 | ;;;-*- Mode: Lisp; Package: CCL -*- 2 | ;;; 3 | ;;; Copyright 2007-2009 Clozure Associates 4 | ;;; 5 | ;;; Licensed under the Apache License, Version 2.0 (the "License"); 6 | ;;; you may not use this file except in compliance with the License. 7 | ;;; You may obtain a copy of the License at 8 | ;;; 9 | ;;; http://www.apache.org/licenses/LICENSE-2.0 10 | ;;; 11 | ;;; Unless required by applicable law or agreed to in writing, software 12 | ;;; distributed under the License is distributed on an "AS IS" BASIS, 13 | ;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | ;;; See the License for the specific language governing permissions and 15 | ;;; limitations under the License. 16 | 17 | (in-package "CCL") 18 | 19 | ;;; It looks like x86-64 Linux, FreeBSD, and Darwin all share the same 20 | ;;; ABI. 21 | 22 | (defun x86-darwin64::record-type-returns-structure-as-first-arg (rtype) 23 | (x8664::record-type-returns-structure-as-first-arg rtype)) 24 | 25 | 26 | 27 | (defun x86-darwin64::expand-ff-call (callform args &key (arg-coerce #'null-coerce-foreign-arg) (result-coerce #'null-coerce-foreign-result)) 28 | (x8664::expand-ff-call callform args :arg-coerce arg-coerce :result-coerce result-coerce)) 29 | 30 | (defun x86-darwin64::generate-callback-bindings (stack-ptr fp-args-ptr argvars argspecs result-spec struct-return-name) 31 | (x8664::generate-callback-bindings stack-ptr fp-args-ptr argvars argspecs result-spec struct-return-name)) 32 | 33 | (defun x86-darwin64::generate-callback-return-value (stack-ptr fp-args-ptr result return-type struct-return-arg) 34 | (x8664::generate-callback-return-value stack-ptr fp-args-ptr result return-type struct-return-arg)) 35 | -------------------------------------------------------------------------------- /lib/ffi-freebsdx8632.lisp: -------------------------------------------------------------------------------- 1 | ;;; 2 | ;;; Copyright 2009 Clozure Associates 3 | ;;; 4 | ;;; Licensed under the Apache License, Version 2.0 (the "License"); 5 | ;;; you may not use this file except in compliance with the License. 6 | ;;; You may obtain a copy of the License at 7 | ;;; 8 | ;;; http://www.apache.org/licenses/LICENSE-2.0 9 | ;;; 10 | ;;; Unless required by applicable law or agreed to in writing, software 11 | ;;; distributed under the License is distributed on an "AS IS" BASIS, 12 | ;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | ;;; See the License for the specific language governing permissions and 14 | ;;; limitations under the License. 15 | 16 | (in-package "CCL") 17 | 18 | ;;; On FreeBSD, the C compiler returns small structures in registers 19 | ;;; (just like on Darwin, apparently). 20 | (defun x86-freebsd32::record-type-returns-structure-as-first-arg (rtype) 21 | (when (and rtype 22 | (not (typep rtype 'unsigned-byte)) 23 | (not (member rtype *foreign-representation-type-keywords* 24 | :test #'eq))) 25 | (let* ((ftype (if (typep rtype 'foreign-type) 26 | rtype 27 | (parse-foreign-type rtype))) 28 | (nbits (ensure-foreign-type-bits ftype))) 29 | (not (member nbits '(8 16 32 64)))))) 30 | 31 | (defun x86-freebsd32::expand-ff-call (callform args &key (arg-coerce #'null-coerce-foreign-arg) (result-coerce #'null-coerce-foreign-result)) 32 | (x8632::expand-ff-call callform args :arg-coerce arg-coerce :result-coerce result-coerce)) 33 | 34 | (defun x86-freebsd32::generate-callback-bindings (stack-ptr fp-args-ptr argvars argspecs result-spec struct-result-name) 35 | (x8632::generate-callback-bindings stack-ptr fp-args-ptr argvars argspecs result-spec struct-result-name)) 36 | 37 | (defun x86-freebsd32::generate-callback-return-value (stack-ptr fp-args-ptr result return-type struct-return-arg) 38 | (x8632::generate-callback-return-value stack-ptr fp-args-ptr result return-type struct-return-arg)) 39 | 40 | -------------------------------------------------------------------------------- /lib/ffi-freebsdx8664.lisp: -------------------------------------------------------------------------------- 1 | ;;;-*- Mode: Lisp; Package: CCL -*- 2 | ;;; 3 | ;;; Copyright 2007-2009 Clozure Associates 4 | ;;; 5 | ;;; Licensed under the Apache License, Version 2.0 (the "License"); 6 | ;;; you may not use this file except in compliance with the License. 7 | ;;; You may obtain a copy of the License at 8 | ;;; 9 | ;;; http://www.apache.org/licenses/LICENSE-2.0 10 | ;;; 11 | ;;; Unless required by applicable law or agreed to in writing, software 12 | ;;; distributed under the License is distributed on an "AS IS" BASIS, 13 | ;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | ;;; See the License for the specific language governing permissions and 15 | ;;; limitations under the License. 16 | 17 | (in-package "CCL") 18 | 19 | ;;; It looks like x86-64 Linux, FreeBSD, and Darwin all share the same 20 | ;;; ABI. 21 | 22 | (defun x86-freebsd64::record-type-returns-structure-as-first-arg (rtype) 23 | (x8664::record-type-returns-structure-as-first-arg rtype)) 24 | 25 | 26 | 27 | (defun x86-freebsd64::expand-ff-call (callform args &key (arg-coerce #'null-coerce-foreign-arg) (result-coerce #'null-coerce-foreign-result)) 28 | (x8664::expand-ff-call callform args :arg-coerce arg-coerce :result-coerce result-coerce)) 29 | 30 | (defun x86-freebsd64::generate-callback-bindings (stack-ptr fp-args-ptr argvars argspecs result-spec struct-return-name) 31 | (x8664::generate-callback-bindings stack-ptr fp-args-ptr argvars argspecs result-spec struct-return-name)) 32 | 33 | (defun x86-freebsd64::generate-callback-return-value (stack-ptr fp-args-ptr result return-type struct-return-arg) 34 | (x8664::generate-callback-return-value stack-ptr fp-args-ptr result return-type struct-return-arg)) 35 | -------------------------------------------------------------------------------- /lib/ffi-linuxx8632.lisp: -------------------------------------------------------------------------------- 1 | ;;; 2 | ;;; Copyright 2009 Clozure Associates 3 | ;;; 4 | ;;; Licensed under the Apache License, Version 2.0 (the "License"); 5 | ;;; you may not use this file except in compliance with the License. 6 | ;;; You may obtain a copy of the License at 7 | ;;; 8 | ;;; http://www.apache.org/licenses/LICENSE-2.0 9 | ;;; 10 | ;;; Unless required by applicable law or agreed to in writing, software 11 | ;;; distributed under the License is distributed on an "AS IS" BASIS, 12 | ;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | ;;; See the License for the specific language governing permissions and 14 | ;;; limitations under the License. 15 | 16 | (in-package "CCL") 17 | 18 | (defun x86-linux32::record-type-returns-structure-as-first-arg (rtype) 19 | (x8632::record-type-returns-structure-as-first-arg rtype)) 20 | 21 | (defun x86-linux32::expand-ff-call (callform args &key (arg-coerce #'null-coerce-foreign-arg) (result-coerce #'null-coerce-foreign-result)) 22 | (x8632::expand-ff-call callform args :arg-coerce arg-coerce :result-coerce result-coerce)) 23 | 24 | (defun x86-linux32::generate-callback-bindings (stack-ptr fp-args-ptr argvars argspecs result-spec struct-result-name) 25 | (x8632::generate-callback-bindings stack-ptr fp-args-ptr argvars argspecs result-spec struct-result-name)) 26 | 27 | (defun x86-linux32::generate-callback-return-value (stack-ptr fp-args-ptr result return-type struct-return-arg) 28 | (x8632::generate-callback-return-value stack-ptr fp-args-ptr result return-type struct-return-arg)) 29 | 30 | -------------------------------------------------------------------------------- /lib/ffi-linuxx8664.lisp: -------------------------------------------------------------------------------- 1 | ;;;-*- Mode: Lisp; Package: CCL -*- 2 | ;;; 3 | ;;; Copyright 2007-2009 Clozure Associates 4 | ;;; 5 | ;;; Licensed under the Apache License, Version 2.0 (the "License"); 6 | ;;; you may not use this file except in compliance with the License. 7 | ;;; You may obtain a copy of the License at 8 | ;;; 9 | ;;; http://www.apache.org/licenses/LICENSE-2.0 10 | ;;; 11 | ;;; Unless required by applicable law or agreed to in writing, software 12 | ;;; distributed under the License is distributed on an "AS IS" BASIS, 13 | ;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | ;;; See the License for the specific language governing permissions and 15 | ;;; limitations under the License. 16 | 17 | 18 | (in-package "CCL") 19 | 20 | ;;; It looks like x86-64 Linux, FreeBSD, and Darwin all share the same 21 | ;;; ABI. 22 | 23 | (defun x86-linux64::record-type-returns-structure-as-first-arg (rtype) 24 | (x8664::record-type-returns-structure-as-first-arg rtype)) 25 | 26 | 27 | 28 | (defun x86-linux64::expand-ff-call (callform args &key (arg-coerce #'null-coerce-foreign-arg) (result-coerce #'null-coerce-foreign-result)) 29 | (x8664::expand-ff-call callform args :arg-coerce arg-coerce :result-coerce result-coerce)) 30 | 31 | 32 | (defun x86-linux64::generate-callback-bindings (stack-ptr fp-args-ptr argvars argspecs result-spec struct-return-name) 33 | (x8664::generate-callback-bindings stack-ptr fp-args-ptr argvars argspecs result-spec struct-return-name)) 34 | 35 | (defun x86-linux64::generate-callback-return-value (stack-ptr fp-args-ptr result return-type struct-return-arg) 36 | (x8664::generate-callback-return-value stack-ptr fp-args-ptr result return-type struct-return-arg)) 37 | -------------------------------------------------------------------------------- /lib/ffi-solarisx8632.lisp: -------------------------------------------------------------------------------- 1 | ;;; 2 | ;;; Copyright 2009 Clozure Associates 3 | ;;; 4 | ;;; Licensed under the Apache License, Version 2.0 (the "License"); 5 | ;;; you may not use this file except in compliance with the License. 6 | ;;; You may obtain a copy of the License at 7 | ;;; 8 | ;;; http://www.apache.org/licenses/LICENSE-2.0 9 | ;;; 10 | ;;; Unless required by applicable law or agreed to in writing, software 11 | ;;; distributed under the License is distributed on an "AS IS" BASIS, 12 | ;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | ;;; See the License for the specific language governing permissions and 14 | ;;; limitations under the License. 15 | 16 | (in-package "CCL") 17 | 18 | (defun x86-solaris32::record-type-returns-structure-as-first-arg (rtype) 19 | (x8632::record-type-returns-structure-as-first-arg rtype)) 20 | 21 | (defun x86-solaris32::expand-ff-call (callform args &key (arg-coerce #'null-coerce-foreign-arg) (result-coerce #'null-coerce-foreign-result)) 22 | (x8632::expand-ff-call callform args :arg-coerce arg-coerce :result-coerce result-coerce)) 23 | 24 | (defun x86-solaris32::generate-callback-bindings (stack-ptr fp-args-ptr argvars argspecs result-spec struct-result-name) 25 | (x8632::generate-callback-bindings stack-ptr fp-args-ptr argvars argspecs result-spec struct-result-name)) 26 | 27 | (defun x86-solaris32::generate-callback-return-value (stack-ptr fp-args-ptr result return-type struct-return-arg) 28 | (x8632::generate-callback-return-value stack-ptr fp-args-ptr result return-type struct-return-arg)) 29 | -------------------------------------------------------------------------------- /lib/ffi-solarisx8664.lisp: -------------------------------------------------------------------------------- 1 | ;;;-*- Mode: Lisp; Package: CCL -*- 2 | ;;; 3 | ;;; Copyright 2008-2009 Clozure Associates 4 | ;;; 5 | ;;; Licensed under the Apache License, Version 2.0 (the "License"); 6 | ;;; you may not use this file except in compliance with the License. 7 | ;;; You may obtain a copy of the License at 8 | ;;; 9 | ;;; http://www.apache.org/licenses/LICENSE-2.0 10 | ;;; 11 | ;;; Unless required by applicable law or agreed to in writing, software 12 | ;;; distributed under the License is distributed on an "AS IS" BASIS, 13 | ;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | ;;; See the License for the specific language governing permissions and 15 | ;;; limitations under the License. 16 | 17 | 18 | (in-package "CCL") 19 | 20 | ;;; It looks like x86-64 Linux, FreeBSD, Darwin, and Solaris all share 21 | ;;; the same ABI. 22 | 23 | (defun x86-solaris64::record-type-returns-structure-as-first-arg (rtype) 24 | (x8664::record-type-returns-structure-as-first-arg rtype)) 25 | 26 | 27 | 28 | (defun x86-solaris64::expand-ff-call (callform args &key (arg-coerce #'null-coerce-foreign-arg) (result-coerce #'null-coerce-foreign-result)) 29 | (x8664::expand-ff-call callform args :arg-coerce arg-coerce :result-coerce result-coerce)) 30 | 31 | 32 | (defun x86-solaris64::generate-callback-bindings (stack-ptr fp-args-ptr argvars argspecs result-spec struct-return-name) 33 | (x8664::generate-callback-bindings stack-ptr fp-args-ptr argvars argspecs result-spec struct-return-name)) 34 | 35 | (defun x86-solaris64::generate-callback-return-value (stack-ptr fp-args-ptr result return-type struct-return-arg) 36 | (x8664::generate-callback-return-value stack-ptr fp-args-ptr result return-type struct-return-arg)) 37 | -------------------------------------------------------------------------------- /lib/ffi-win32.lisp: -------------------------------------------------------------------------------- 1 | ;;; 2 | ;;; Copyright 2009 Clozure Associates 3 | ;;; 4 | ;;; Licensed under the Apache License, Version 2.0 (the "License"); 5 | ;;; you may not use this file except in compliance with the License. 6 | ;;; You may obtain a copy of the License at 7 | ;;; 8 | ;;; http://www.apache.org/licenses/LICENSE-2.0 9 | ;;; 10 | ;;; Unless required by applicable law or agreed to in writing, software 11 | ;;; distributed under the License is distributed on an "AS IS" BASIS, 12 | ;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | ;;; See the License for the specific language governing permissions and 14 | ;;; limitations under the License. 15 | 16 | (in-package "CCL") 17 | 18 | ;;; Cygwin compiler returns small structures in registers 19 | ;;; (just like on Darwin, apparently). 20 | (defun win32::record-type-returns-structure-as-first-arg (rtype) 21 | (when (and rtype 22 | (not (typep rtype 'unsigned-byte)) 23 | (not (member rtype *foreign-representation-type-keywords* 24 | :test #'eq))) 25 | (let* ((ftype (if (typep rtype 'foreign-type) 26 | rtype 27 | (parse-foreign-type rtype))) 28 | (nbits (ensure-foreign-type-bits ftype))) 29 | (not (member nbits '(8 16 32 64)))))) 30 | 31 | (defun win32::expand-ff-call (callform args &key (arg-coerce #'null-coerce-foreign-arg) (result-coerce #'null-coerce-foreign-result)) 32 | (x8632::expand-ff-call callform args :arg-coerce arg-coerce :result-coerce result-coerce)) 33 | 34 | (defun win32::generate-callback-bindings (stack-ptr fp-args-ptr argvars argspecs result-spec struct-result-name) 35 | (x8632::generate-callback-bindings stack-ptr fp-args-ptr argvars argspecs result-spec struct-result-name)) 36 | 37 | (defun win32::generate-callback-return-value (stack-ptr fp-args-ptr result return-type struct-return-arg) 38 | (x8632::generate-callback-return-value stack-ptr fp-args-ptr result return-type struct-return-arg)) 39 | 40 | -------------------------------------------------------------------------------- /lib/mcl-compat.lisp: -------------------------------------------------------------------------------- 1 | ;;;-*-Mode: LISP; Package: CCL -*- 2 | ;;; 3 | ;;; Copyright 1994-2009 Clozure Associates 4 | ;;; 5 | ;;; Licensed under the Apache License, Version 2.0 (the "License"); 6 | ;;; you may not use this file except in compliance with the License. 7 | ;;; You may obtain a copy of the License at 8 | ;;; 9 | ;;; http://www.apache.org/licenses/LICENSE-2.0 10 | ;;; 11 | ;;; Unless required by applicable law or agreed to in writing, software 12 | ;;; distributed under the License is distributed on an "AS IS" BASIS, 13 | ;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | ;;; See the License for the specific language governing permissions and 15 | ;;; limitations under the License. 16 | 17 | (in-package "CCL") 18 | 19 | ;;; mcl-compat.lisp - (some) backwards-compatibility with traditional MCL 20 | ;;; (CLtL2/ANSI, etc.) 21 | 22 | ;;; Gratuitous name changes, for the most part: 23 | 24 | (deftype base-character () 'base-char) 25 | (deftype extended-character () 'extended-char) 26 | 27 | (defmacro define-setf-method (access-fn lambda-list &body body) 28 | `(define-setf-expander ,access-fn ,lambda-list ,@body)) 29 | 30 | (defun get-setf-method (form &optional environment) 31 | (get-setf-expansion-aux form environment nil)) 32 | 33 | (defun get-setf-method-multiple-value (form &optional environment) 34 | "Like Get-Setf-Method, but may return multiple new-value variables." 35 | (get-setf-expansion-aux form environment t)) 36 | 37 | ;;; Traditional MCL I/O primitives: 38 | 39 | (defun tyi (stream) 40 | (let* ((ch (stream-read-char stream))) 41 | (unless (eq ch :eof) ch))) 42 | 43 | (defun untyi (ch &optional stream) 44 | (stream-unread-char (designated-input-stream stream) ch)) 45 | 46 | (defun tyo (ch &optional stream) 47 | (stream-write-char (real-print-stream stream) ch)) 48 | -------------------------------------------------------------------------------- /lib/print-db.lisp: -------------------------------------------------------------------------------- 1 | ; -*- Mode:Lisp; Package:CCL; -*- 2 | ;;; 3 | ;;; Copyright 1994-2009 Clozure Associates 4 | ;;; 5 | ;;; Licensed under the Apache License, Version 2.0 (the "License"); 6 | ;;; you may not use this file except in compliance with the License. 7 | ;;; You may obtain a copy of the License at 8 | ;;; 9 | ;;; http://www.apache.org/licenses/LICENSE-2.0 10 | ;;; 11 | ;;; Unless required by applicable law or agreed to in writing, software 12 | ;;; distributed under the License is distributed on an "AS IS" BASIS, 13 | ;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | ;;; See the License for the specific language governing permissions and 15 | ;;; limitations under the License. 16 | 17 | (in-package "CCL") 18 | 19 | (defmacro print-db (&rest forms &aux) 20 | `(multiple-value-prog1 21 | (progn ,@(print-db-aux forms)) 22 | (terpri *trace-output*))) 23 | 24 | (defun print-db-aux (forms) 25 | (when forms 26 | (cond ((stringp (car forms)) 27 | `((print ',(car forms) *trace-output*) 28 | ,@(print-db-aux (cdr forms)))) 29 | ((null (cdr forms)) 30 | `((print ',(car forms) *trace-output*) 31 | (let ((values (multiple-value-list ,(car forms)))) 32 | (prin1 (car values) *trace-output*) 33 | (apply #'values values)))) 34 | (t `((print ',(car forms) *trace-output*) 35 | (prin1 ,(car forms) *trace-output*) 36 | ,@(print-db-aux (cdr forms))))))) 37 | 38 | 39 | -------------------------------------------------------------------------------- /library/chud-metering.txt: -------------------------------------------------------------------------------- 1 | See section 11.2 of the Clozure CL manual. 2 | -------------------------------------------------------------------------------- /library/sharp-comma.lisp: -------------------------------------------------------------------------------- 1 | ;;;-*- Mode: Lisp; Package: CCL -*- 2 | ;;; 3 | ;;; Copyright 1994-2001 Clozure Associates 4 | ;;; 5 | ;;; Licensed under the Apache License, Version 2.0 (the "License"); 6 | ;;; you may not use this file except in compliance with the License. 7 | ;;; You may obtain a copy of the License at 8 | ;;; 9 | ;;; http://www.apache.org/licenses/LICENSE-2.0 10 | ;;; 11 | ;;; Unless required by applicable law or agreed to in writing, software 12 | ;;; distributed under the License is distributed on an "AS IS" BASIS, 13 | ;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | ;;; See the License for the specific language governing permissions and 15 | ;;; limitations under the License. 16 | 17 | 18 | (in-package "CCL") 19 | 20 | ;;; #, was removed from CL in 1998 or so, but there may be some legacy 21 | ;;; code that still uses it. 22 | 23 | (set-dispatch-macro-character 24 | #\# 25 | #\, 26 | #'(lambda (stream subchar numarg) 27 | (let* ((sharp-comma-token *reading-for-cfasl*)) 28 | (if (or *read-suppress* (not *compiling-file*) (not sharp-comma-token)) 29 | (read-eval stream subchar numarg) 30 | (progn 31 | (require-no-numarg subchar numarg) 32 | (list sharp-comma-token (read stream t nil t))))))) 33 | -------------------------------------------------------------------------------- /lisp-kernel/androidarm/aarmcl.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | 9 | int 10 | (*cclmain)(); 11 | 12 | int 13 | main(int argc, char *argv[], char *envp, void *auxv) 14 | { 15 | char buf[PATH_MAX], *path, *lastslash; 16 | int n, prefixlen; 17 | void *libhandle, **dynamic_entries; 18 | 19 | if ((n = readlink("/proc/self/exe", buf, PATH_MAX)) > 0) { 20 | path = malloc(n+4+3); 21 | buf[n] = 0; 22 | lastslash = strrchr(buf,'/'); 23 | if (lastslash) { 24 | lastslash++; 25 | prefixlen = lastslash-buf; 26 | strncpy(path,buf,prefixlen); 27 | path[prefixlen] = 0; 28 | strcat(path,"lib"); 29 | strcat(path,lastslash); 30 | strcat(path,".so"); 31 | } else { 32 | memmove(path,"lib",3); 33 | memmove(path+3,buf,n); 34 | memmove(path+3+n,".so",3); 35 | path[n+3+3] = 0; 36 | } 37 | libhandle = dlopen(path,RTLD_GLOBAL|RTLD_NOW); 38 | if (libhandle != NULL) { 39 | cclmain = dlsym(libhandle, "cclmain"); 40 | if (cclmain != NULL) { 41 | dynamic_entries = dlsym(libhandle,"android_executable_dynamic_section"); 42 | *dynamic_entries = &_DYNAMIC; 43 | return cclmain(argc,argv,envp, auxv); 44 | } else { 45 | fprintf(stderr, "Couldn't resolve library entrpoint.\n"); 46 | } 47 | } else { 48 | fprintf(stderr, "Couldn't open shared library %s : %s\n", 49 | path, dlerror()); 50 | } 51 | return 1; 52 | } 53 | } 54 | 55 | 56 | 57 | 58 | 59 | -------------------------------------------------------------------------------- /lisp-kernel/androidarm/fixlib.c: -------------------------------------------------------------------------------- 1 | /* Copyright (C) 2011 Clozure Associates */ 2 | /* This file is part of Clozure CL. */ 3 | 4 | /* Clozure CL is licensed under the terms of the Lisp Lesser GNU Public */ 5 | /* License , known as the LLGPL and distributed with Clozure CL as the */ 6 | /* file "LICENSE". The LLGPL consists of a preamble and the LGPL, */ 7 | /* which is distributed with Clozure CL as the file "LGPL". Where these */ 8 | /* conflict, the preamble takes precedence. */ 9 | 10 | /* Clozure CL is referenced in the preamble as the "LIBRARY." */ 11 | 12 | /* The LLGPL is also available online at */ 13 | /* http://opensource.franz.com/preamble.html */ 14 | 15 | 16 | #include 17 | #include 18 | #include 19 | 20 | 21 | struct android_preload_info { 22 | unsigned long addr; 23 | char sig[4]; 24 | }; 25 | 26 | 27 | main(int argc, char **argv) 28 | { 29 | struct android_preload_info info = {0, "PRE "}; 30 | 31 | if (argc == 2) { 32 | info.addr = strtoul(argv[1],NULL,0); 33 | if (write(1,&info,sizeof(info)) == sizeof(info)) { 34 | return 0; 35 | } 36 | } 37 | return 1; 38 | } 39 | 40 | -------------------------------------------------------------------------------- /lisp-kernel/androidarm/link.h: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/lisp-kernel/androidarm/link.h -------------------------------------------------------------------------------- /lisp-kernel/arm64-exceptions.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright 2016 Clozure Associates 3 | * 4 | * Licensed under the Apache License, Version 2.0 (the "License"); 5 | * you may not use this file except in compliance with the License. 6 | * You may obtain a copy of the License at 7 | * 8 | * http://www.apache.org/licenses/LICENSE-2.0 9 | * 10 | * Unless required by applicable law or agreed to in writing, software 11 | * distributed under the License is distributed on an "AS IS" BASIS, 12 | * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | * See the License for the specific language governing permissions and 14 | * limitations under the License. 15 | */ 16 | -------------------------------------------------------------------------------- /lisp-kernel/bits.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright 1994-2009 Clozure Associates 3 | * 4 | * Licensed under the Apache License, Version 2.0 (the "License"); 5 | * you may not use this file except in compliance with the License. 6 | * You may obtain a copy of the License at 7 | * 8 | * http://www.apache.org/licenses/LICENSE-2.0 9 | * 10 | * Unless required by applicable law or agreed to in writing, software 11 | * distributed under the License is distributed on an "AS IS" BASIS, 12 | * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | * See the License for the specific language governing permissions and 14 | * limitations under the License. 15 | */ 16 | 17 | 18 | #include "lisp.h" 19 | #include "bits.h" 20 | #include "lisp-exceptions.h" 21 | 22 | 23 | /* This should be a lot faster than calling set_bit N times */ 24 | 25 | void 26 | set_n_bits(bitvector bits, natural first, natural n) 27 | { 28 | if (n) { 29 | natural 30 | lastbit = (first+n)-1, 31 | leftbit = first & bitmap_shift_count_mask, 32 | leftmask = ALL_ONES >> leftbit, 33 | rightmask = ALL_ONES << ((nbits_in_word-1) - (lastbit & bitmap_shift_count_mask)), 34 | *wstart = ((natural *) bits) + (first>>bitmap_shift), 35 | *wend = ((natural *) bits) + (lastbit>>bitmap_shift); 36 | 37 | if (wstart == wend) { 38 | *wstart |= (leftmask & rightmask); 39 | } else { 40 | *wstart++ |= leftmask; 41 | n -= (nbits_in_word - leftbit); 42 | 43 | while (n >= nbits_in_word) { 44 | *wstart++ = ALL_ONES; 45 | n-= nbits_in_word; 46 | } 47 | 48 | if (n) { 49 | *wstart |= rightmask; 50 | } 51 | } 52 | } 53 | } 54 | 55 | /* Note that this zeros natural-sized words */ 56 | void 57 | zero_bits(bitvector bits, natural nbits) 58 | { 59 | natural i, n = (((nbits+(nbits_in_word-1)))>>bitmap_shift); 60 | 61 | for(i=0; i < n; i++) { 62 | bits[i]= 0; 63 | } 64 | } 65 | 66 | void 67 | ior_bits(bitvector dest, bitvector src, natural nbits) 68 | { 69 | while (nbits > 0) { 70 | *dest++ |= *src++; 71 | nbits -= nbits_in_word; 72 | } 73 | } 74 | -------------------------------------------------------------------------------- /lisp-kernel/darwinx8632/.gdbinit: -------------------------------------------------------------------------------- 1 | define pl 2 | call print_lisp_object($arg0) 3 | end 4 | 5 | define showlist 6 | set $l=$arg0 7 | while $l != 0x3001 8 | set $car = *((LispObj *)($l+3)) 9 | set $l = *((LispObj *)($l-1)) 10 | pl $car 11 | end 12 | end 13 | 14 | 15 | define fn 16 | pl $edi 17 | end 18 | 19 | define arg_y 20 | pl $esi 21 | end 22 | 23 | define arg_z 24 | pl $ebx 25 | end 26 | 27 | define offset 28 | p (int)$pc-$edi 29 | end 30 | 31 | 32 | break Bug 33 | 34 | display/i $pc 35 | 36 | handle SIGKILL pass nostop noprint 37 | handle SIGILL pass nostop noprint 38 | handle SIGSEGV pass nostop noprint 39 | handle SIGBUS pass nostop noprint 40 | handle SIGFPE pass nostop noprint 41 | handle SIGUSR1 pass nostop noprint 42 | handle SIGUSR2 pass nostop noprint 43 | handle SIGEMT pass nostop noprint 44 | # Work around apparent Apple GDB bug 45 | handle SIGTTIN nopass nostop noprint 46 | # Work around Leopard bug du jour 47 | handle SIGSYS pass nostop noprint 48 | 49 | -------------------------------------------------------------------------------- /lisp-kernel/darwinx8664/.gdbinit: -------------------------------------------------------------------------------- 1 | define x86_lisp_string 2 | x/s $arg0-5 3 | end 4 | 5 | define x86pname 6 | set $temp=*((long *)((long)($arg0-6))) 7 | x86_lisp_string $temp 8 | end 9 | 10 | define gtra 11 | br *$r10 12 | cont 13 | end 14 | 15 | 16 | define pname 17 | x86pname $arg0 18 | end 19 | 20 | define pl 21 | call print_lisp_object($arg0) 22 | end 23 | 24 | define lw 25 | pl $r13 26 | end 27 | 28 | define clobber_breakpoint 29 | set *(short *)($pc-2)=0x9090 30 | end 31 | 32 | define arg_z 33 | pl $rsi 34 | end 35 | 36 | define arg_y 37 | pl $rdi 38 | end 39 | 40 | define arg_x 41 | pl $r8 42 | end 43 | 44 | define bx 45 | pl $rbx 46 | end 47 | 48 | 49 | define lbt 50 | call plbt_sp($rbp) 51 | end 52 | 53 | define ada 54 | p/x *(all_areas->succ) 55 | end 56 | 57 | define lregs 58 | call debug_lisp_registers($arg0,0,0) 59 | end 60 | 61 | break Bug 62 | 63 | display/i $pc 64 | 65 | handle SIGKILL pass nostop noprint 66 | handle SIGILL pass nostop noprint 67 | handle SIGSEGV pass nostop noprint 68 | handle SIGBUS pass nostop noprint 69 | handle SIGFPE pass nostop noprint 70 | handle SIGUSR1 pass nostop noprint 71 | handle SIGUSR2 pass nostop noprint 72 | handle SIGEMT pass nostop noprint 73 | # Work around apparent Apple GDB bug 74 | handle SIGTTIN nopass nostop noprint 75 | # Work around Leopard bug du jour 76 | handle SIGSYS pass nostop noprint 77 | handle SIGQUIT pass nostop noprint 78 | 79 | -------------------------------------------------------------------------------- /lisp-kernel/darwinx8664/lldbinit: -------------------------------------------------------------------------------- 1 | process handle --notify false --pass true --stop false SIGKILL SIGILL SIGSEGV SIGBUS SIGFPE SIGUSR1 SIGUSR2 SIGEMT 2 | 3 | # this doesn't work until a target is defined 4 | target stop-hook add --one-liner "disassemble --pc" 5 | 6 | command alias arg_x expr print_lisp_object($r8) 7 | command alias arg_y expr print_lisp_object($rdi) 8 | command alias arg_z expr print_lisp_object($rsi) 9 | command alias fn expr print_lisp_object($r13) 10 | 11 | command alias lbt expr plbt_sp($rbp) 12 | 13 | -------------------------------------------------------------------------------- /lisp-kernel/freebsdx8632/.gdbinit: -------------------------------------------------------------------------------- 1 | define pl 2 | call print_lisp_object($arg0) 3 | end 4 | 5 | define showlist 6 | set $l=$arg0 7 | while $l != 0x3001 8 | set $car = *((LispObj *)($l+3)) 9 | set $l = *((LispObj *)($l-1)) 10 | pl $car 11 | end 12 | end 13 | 14 | 15 | define fn 16 | pl $edi 17 | end 18 | 19 | define arg_y 20 | pl $esi 21 | end 22 | 23 | define arg_z 24 | pl $ebx 25 | end 26 | 27 | define offset 28 | p (int)$pc-$edi 29 | end 30 | 31 | 32 | break Bug 33 | 34 | display/i $pc 35 | 36 | handle SIGKILL pass nostop noprint 37 | handle SIGILL pass nostop noprint 38 | handle SIGSEGV pass nostop noprint 39 | handle SIGBUS pass nostop noprint 40 | handle SIGFPE pass nostop noprint 41 | handle SIGEMT pass nostop noprint 42 | handle SIGUSR1 pass nostop noprint 43 | handle SIGUSR2 pass nostop noprint 44 | -------------------------------------------------------------------------------- /lisp-kernel/freebsdx8664/.gdbinit: -------------------------------------------------------------------------------- 1 | define x86_lisp_string 2 | x/s $arg0-5 3 | end 4 | 5 | define x86pname 6 | set $temp=*((long *)((long)($arg0-6))) 7 | x86_lisp_string $temp 8 | end 9 | 10 | 11 | define pname 12 | x86pname $arg0 13 | end 14 | 15 | define l 16 | call print_lisp_object($arg0) 17 | end 18 | 19 | define lw 20 | l $r13 21 | end 22 | 23 | define clobber_breakpoint 24 | set *(short *)($pc-2)=0x9090 25 | end 26 | 27 | define arg_z 28 | l $rsi 29 | end 30 | 31 | define arg_y 32 | l $rdi 33 | end 34 | 35 | define arg_x 36 | l $r8 37 | end 38 | 39 | define bx 40 | l $rbx 41 | end 42 | 43 | define showlist 44 | set $l=$arg0 45 | while $l != 0x200b 46 | set $car = *((LispObj *)($l+5)) 47 | set $l = *((LispObj *)($l-3)) 48 | l $car 49 | end 50 | end 51 | 52 | define lbt 53 | call plbt_sp($rbp) 54 | end 55 | 56 | define ada 57 | p/x *(all_areas->succ) 58 | end 59 | 60 | define lregs 61 | call debug_lisp_registers($arg0,0,0) 62 | end 63 | 64 | break Bug 65 | 66 | display/i $pc 67 | 68 | handle SIGKILL pass nostop noprint 69 | handle SIGILL pass nostop noprint 70 | handle SIGSEGV pass nostop noprint 71 | handle SIGBUS pass nostop noprint 72 | handle SIGFPE pass nostop noprint 73 | handle SIGEMT pass nostop noprint 74 | handle SIGUSR1 pass nostop noprint 75 | handle SIGUSR2 pass nostop noprint 76 | -------------------------------------------------------------------------------- /lisp-kernel/kernel-globals.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright 1994-2009 Clozure Associates 3 | * 4 | * Licensed under the Apache License, Version 2.0 (the "License"); 5 | * you may not use this file except in compliance with the License. 6 | * You may obtain a copy of the License at 7 | * 8 | * http://www.apache.org/licenses/LICENSE-2.0 9 | * 10 | * Unless required by applicable law or agreed to in writing, software 11 | * distributed under the License is distributed on an "AS IS" BASIS, 12 | * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | * See the License for the specific language governing permissions and 14 | * limitations under the License. 15 | */ 16 | 17 | #ifndef __kernel_globals__ 18 | #define __kernel_globals__ 19 | #include "area.h" 20 | 21 | 22 | extern area *nilreg_area, *tenured_area, *g2_area, *g1_area, *managed_static_area, *readonly_area, *static_cons_area; 23 | extern area *all_areas; 24 | extern int cache_block_size; 25 | 26 | 27 | 28 | 29 | 30 | 31 | 32 | #endif /* __kernel_globals__ */ 33 | -------------------------------------------------------------------------------- /lisp-kernel/linuxarm/.gdbinit: -------------------------------------------------------------------------------- 1 | # Some environments (gdb mode in XEmacs) interact poorly with 2 | # the readline-based line editing features in some versions of GDB. 3 | set editing off 4 | define pl 5 | call print_lisp_object($arg0) 6 | end 7 | break Bug 8 | 9 | display/i $pc 10 | 11 | handle SIGKILL pass nostop noprint 12 | handle SIGILL pass nostop noprint 13 | handle SIGSEGV pass nostop noprint 14 | handle SIGBUS pass nostop noprint 15 | handle SIGFPE pass nostop noprint 16 | handle SIG40 pass nostop noprint 17 | handle SIG41 pass nostop noprint 18 | handle SIG42 pass nostop noprint 19 | handle SIGPWR pass nostop noprint 20 | 21 | 22 | -------------------------------------------------------------------------------- /lisp-kernel/linuxarm/float_abi.mk: -------------------------------------------------------------------------------- 1 | # By default, use the toolchain default -mfloat-abi option 2 | FLOAT_ABI_OPTION = 3 | # If you change this, do 'make clean' to remove any object files 4 | # compiled for the other ABI. 5 | #FLOAT_ABI_OPTION = -mfloat-abi=softfp 6 | #FLOAT_ABI_OPTION = -mfloat-abi=hard 7 | 8 | -------------------------------------------------------------------------------- /lisp-kernel/linuxppc/.gdbinit: -------------------------------------------------------------------------------- 1 | directory lisp-kernel 2 | 3 | define pl 4 | call print_lisp_object($arg0) 5 | end 6 | 7 | define ada 8 | p *all_areas->succ 9 | end 10 | 11 | define _TCR 12 | p/x *(TCR *) $arg0 13 | end 14 | 15 | define tcr32 16 | _TCR $r13 17 | end 18 | 19 | define tcr64 20 | _TCR $r2 21 | end 22 | 23 | define regs32 24 | p/x *(((struct pt_regs **)$arg0)[12]) 25 | end 26 | 27 | define regs64 28 | p/x * (((ExceptionInformation *)$arg0)->uc_mcontext.regs) 29 | end 30 | 31 | define xpGPR 32 | p/x (((struct pt_regs **)$arg0)[12])->gpr[$arg1] 33 | end 34 | 35 | define xpPC 36 | p/x ((ExceptionInformation *)$arg0)->uc_mcontext.regs->nip 37 | end 38 | 39 | define lisp_string 40 | if $ppc64 41 | lisp_string64 $arg0 42 | else 43 | lisp_string32 $arg0 44 | end 45 | end 46 | 47 | define pname 48 | if $ppc64 49 | pname64 $arg0 50 | else 51 | pname32 $arg0 52 | end 53 | end 54 | 55 | define tcr 56 | if $ppc64 57 | tcr64 58 | else 59 | tcr32 60 | end 61 | end 62 | 63 | define regs 64 | if $ppc64 65 | regs64 $arg0 66 | else 67 | regs32 $arg0 68 | end 69 | end 70 | 71 | define xpGPR 72 | if $ppc64 73 | xpGPR64 $arg0 $arg1 74 | else 75 | xpGPR32 $arg0 $arg1 76 | end 77 | end 78 | 79 | define lisp 80 | call print_lisp_object($arg0) 81 | end 82 | 83 | set $ppc64=0 84 | 85 | 86 | break Bug 87 | 88 | handle SIGILL pass nostop noprint 89 | handle SIGSEGV pass nostop noprint 90 | handle SIGBUS pass nostop noprint 91 | handle SIGFPE pass nostop noprint 92 | handle SIG40 pass nostop noprint 93 | handle SIG41 pass nostop noprint 94 | handle SIG42 pass nostop noprint 95 | handle SIGPWR pass nostop noprint 96 | 97 | display/i $pc 98 | -------------------------------------------------------------------------------- /lisp-kernel/linuxx8632/.gdbinit: -------------------------------------------------------------------------------- 1 | define pl 2 | call print_lisp_object($arg0) 3 | end 4 | 5 | define showlist 6 | set $l=$arg0 7 | while $l != 0x3001 8 | set $car = *((LispObj *)($l+3)) 9 | set $l = *((LispObj *)($l-1)) 10 | pl $car 11 | end 12 | end 13 | 14 | 15 | define fn 16 | pl $edi 17 | end 18 | 19 | define arg_y 20 | pl $esi 21 | end 22 | 23 | define arg_z 24 | pl $ebx 25 | end 26 | 27 | define offset 28 | p (int)$pc-$edi 29 | end 30 | 31 | 32 | break Bug 33 | 34 | display/i $pc 35 | 36 | handle SIGKILL pass nostop noprint 37 | handle SIGILL pass nostop noprint 38 | handle SIGSEGV pass nostop noprint 39 | handle SIGBUS pass nostop noprint 40 | handle SIGFPE pass nostop noprint 41 | handle SIG40 pass nostop noprint 42 | handle SIG41 pass nostop noprint 43 | handle SIG42 pass nostop noprint 44 | handle SIGPWR pass nostop noprint 45 | handle SIGQUIT pass nostop noprint 46 | 47 | -------------------------------------------------------------------------------- /lisp-kernel/linuxx8664/.gdbinit: -------------------------------------------------------------------------------- 1 | define x86_lisp_string 2 | x/s $arg0-5 3 | end 4 | 5 | define gtra 6 | br *$r10 7 | cont 8 | end 9 | 10 | define x86pname 11 | set $temp=*((long *)((long)($arg0-6))) 12 | x86_lisp_string $temp 13 | end 14 | 15 | 16 | define pname 17 | x86pname $arg0 18 | end 19 | 20 | define l 21 | call print_lisp_object($arg0) 22 | end 23 | 24 | define lw 25 | l $r13 26 | end 27 | 28 | define clobber_breakpoint 29 | set *(short *)($pc-2)=0x9090 30 | end 31 | 32 | define arg_z 33 | l $rsi 34 | end 35 | 36 | define arg_y 37 | l $rdi 38 | end 39 | 40 | define arg_x 41 | l $r8 42 | end 43 | 44 | define bx 45 | l $rbx 46 | end 47 | 48 | define showlist 49 | set $l=$arg0 50 | while $l != 0x200b 51 | set $car = *((LispObj *)($l+5)) 52 | set $l = *((LispObj *)($l-3)) 53 | l $car 54 | end 55 | end 56 | 57 | define lbt 58 | call plbt_sp($rbp) 59 | end 60 | 61 | define ada 62 | p/x *(all_areas->succ) 63 | end 64 | 65 | define lregs 66 | call debug_lisp_registers($arg0,0,0) 67 | end 68 | 69 | break Bug 70 | 71 | display/i $pc 72 | 73 | handle SIGKILL pass nostop noprint 74 | handle SIGILL pass nostop noprint 75 | handle SIGSEGV pass nostop noprint 76 | handle SIGBUS pass nostop noprint 77 | handle SIGFPE pass nostop noprint 78 | handle SIG40 pass nostop noprint 79 | handle SIG41 pass nostop noprint 80 | handle SIG42 pass nostop noprint 81 | handle SIGPWR pass nostop noprint 82 | handle SIGQUIT pass nostop noprint 83 | 84 | -------------------------------------------------------------------------------- /lisp-kernel/lispdcmd.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright 1994-2009 Clozure Associates 3 | * 4 | * Licensed under the Apache License, Version 2.0 (the "License"); 5 | * you may not use this file except in compliance with the License. 6 | * You may obtain a copy of the License at 7 | * 8 | * http://www.apache.org/licenses/LICENSE-2.0 9 | * 10 | * Unless required by applicable law or agreed to in writing, software 11 | * distributed under the License is distributed on an "AS IS" BASIS, 12 | * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | * See the License for the specific language governing permissions and 14 | * limitations under the License. 15 | */ 16 | 17 | /* 18 | MCL-PPC dcmd utilities. 19 | */ 20 | 21 | #include "lispdcmd.h" 22 | 23 | 24 | 25 | 26 | void 27 | display_buffer(char *buf) 28 | { 29 | fprintf(dbgout, "%s\n", buf); 30 | } 31 | 32 | int 33 | Dprintf(const char *format, ...) 34 | { 35 | char buf[512]; 36 | va_list args; 37 | int res; 38 | 39 | va_start(args, format); 40 | res = vsnprintf(buf, sizeof(buf), format, args); 41 | if (res >= 0) { 42 | display_buffer(buf); 43 | } 44 | return res; 45 | } 46 | 47 | -------------------------------------------------------------------------------- /lisp-kernel/lispdcmd.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright 1994-2009 Clozure Associates 3 | * 4 | * Licensed under the Apache License, Version 2.0 (the "License"); 5 | * you may not use this file except in compliance with the License. 6 | * You may obtain a copy of the License at 7 | * 8 | * http://www.apache.org/licenses/LICENSE-2.0 9 | * 10 | * Unless required by applicable law or agreed to in writing, software 11 | * distributed under the License is distributed on an "AS IS" BASIS, 12 | * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | * See the License for the specific language governing permissions and 14 | * limitations under the License. 15 | */ 16 | 17 | #include 18 | #include 19 | 20 | #include "lisp.h" 21 | #include "area.h" 22 | #include "lisp-exceptions.h" 23 | #include "lisp_globals.h" 24 | 25 | /* More-or-less like c printf(); */ 26 | int Dprintf(const char *format, ...); 27 | 28 | 29 | char * 30 | print_lisp_object(LispObj); 31 | -------------------------------------------------------------------------------- /lisp-kernel/lisptypes.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright 1994-2009 Clozure Associates 3 | * 4 | * Licensed under the Apache License, Version 2.0 (the "License"); 5 | * you may not use this file except in compliance with the License. 6 | * You may obtain a copy of the License at 7 | * 8 | * http://www.apache.org/licenses/LICENSE-2.0 9 | * 10 | * Unless required by applicable law or agreed to in writing, software 11 | * distributed under the License is distributed on an "AS IS" BASIS, 12 | * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | * See the License for the specific language governing permissions and 14 | * limitations under the License. 15 | */ 16 | 17 | #ifndef __lisptypes__ 18 | #define __lisptypes__ 19 | 20 | #include 21 | 22 | #if WORD_SIZE == 64 23 | typedef uint64_t LispObj; 24 | typedef uint64_t natural; 25 | typedef int64_t signed_natural; 26 | #else 27 | typedef uint32_t LispObj; 28 | typedef uint32_t natural; 29 | typedef int32_t signed_natural; 30 | #endif 31 | 32 | typedef int32_t lisp_char_code; 33 | 34 | typedef int OSStatus, OSErr; 35 | #define noErr ((OSErr) 0) 36 | typedef int Boolean; 37 | typedef void *LogicalAddress; 38 | typedef char *Ptr, *BytePtr, *StringPtr; 39 | 40 | #define true 1 41 | #define false 0 42 | 43 | #endif /*__lisptypes__ */ 44 | -------------------------------------------------------------------------------- /lisp-kernel/mach_exc.defs: -------------------------------------------------------------------------------- 1 | #include 2 | -------------------------------------------------------------------------------- /lisp-kernel/os-darwin.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright 1994-2010 Clozure Associates 3 | * 4 | * Licensed under the Apache License, Version 2.0 (the "License"); 5 | * you may not use this file except in compliance with the License. 6 | * You may obtain a copy of the License at 7 | * 8 | * http://www.apache.org/licenses/LICENSE-2.0 9 | * 10 | * Unless required by applicable law or agreed to in writing, software 11 | * distributed under the License is distributed on an "AS IS" BASIS, 12 | * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | * See the License for the specific language governing permissions and 14 | * limitations under the License. 15 | */ 16 | 17 | #define SIGNAL_FOR_PROCESS_INTERRUPT SIGUSR1 18 | 19 | #define SIG_SUSPEND_THREAD SIGUSR2 20 | 21 | #define SIG_KILL_THREAD SIGEMT 22 | 23 | #ifdef USE_DTRACE 24 | #include "probes.h" 25 | #endif 26 | 27 | -------------------------------------------------------------------------------- /lisp-kernel/os-freebsd.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright 1994-2010 Clozure Associates 3 | * 4 | * Licensed under the Apache License, Version 2.0 (the "License"); 5 | * you may not use this file except in compliance with the License. 6 | * You may obtain a copy of the License at 7 | * 8 | * http://www.apache.org/licenses/LICENSE-2.0 9 | * 10 | * Unless required by applicable law or agreed to in writing, software 11 | * distributed under the License is distributed on an "AS IS" BASIS, 12 | * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | * See the License for the specific language governing permissions and 14 | * limitations under the License. 15 | */ 16 | 17 | #define SIGNAL_FOR_PROCESS_INTERRUPT SIGEMT 18 | #define SIG_SUSPEND_THREAD SIGUSR2 19 | #define SIG_KILL_THREAD (SIGTHR+5) 20 | -------------------------------------------------------------------------------- /lisp-kernel/os-linux.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright 1994-2010 Clozure Associates 3 | * 4 | * Licensed under the Apache License, Version 2.0 (the "License"); 5 | * you may not use this file except in compliance with the License. 6 | * You may obtain a copy of the License at 7 | * 8 | * http://www.apache.org/licenses/LICENSE-2.0 9 | * 10 | * Unless required by applicable law or agreed to in writing, software 11 | * distributed under the License is distributed on an "AS IS" BASIS, 12 | * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | * See the License for the specific language governing permissions and 14 | * limitations under the License. 15 | */ 16 | 17 | #define SIGNAL_FOR_PROCESS_INTERRUPT SIGPWR 18 | #ifdef ANDROID 19 | #define SIG_SUSPEND_THREAD SIGUSR2 20 | #define SIG_KILL_THREAD SIGXCPU 21 | #else 22 | #define SIG_SUSPEND_THREAD (SIGRTMIN+6) 23 | #define SIG_KILL_THREAD (SIGRTMIN+7) 24 | #endif 25 | -------------------------------------------------------------------------------- /lisp-kernel/os-solaris.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright 1994-2010 Clozure Associates 3 | * 4 | * Licensed under the Apache License, Version 2.0 (the "License"); 5 | * you may not use this file except in compliance with the License. 6 | * You may obtain a copy of the License at 7 | * 8 | * http://www.apache.org/licenses/LICENSE-2.0 9 | * 10 | * Unless required by applicable law or agreed to in writing, software 11 | * distributed under the License is distributed on an "AS IS" BASIS, 12 | * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | * See the License for the specific language governing permissions and 14 | * limitations under the License. 15 | */ 16 | 17 | #define SIGNAL_FOR_PROCESS_INTERRUPT SIGUSR1 18 | #define SIG_SUSPEND_THREAD SIGUSR2 19 | #define SIG_KILL_THREAD SIGRTMIN 20 | -------------------------------------------------------------------------------- /lisp-kernel/os-windows.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright 1994-2010 Clozure Associates 3 | * 4 | * Licensed under the Apache License, Version 2.0 (the "License"); 5 | * you may not use this file except in compliance with the License. 6 | * You may obtain a copy of the License at 7 | * 8 | * http://www.apache.org/licenses/LICENSE-2.0 9 | * 10 | * Unless required by applicable law or agreed to in writing, software 11 | * distributed under the License is distributed on an "AS IS" BASIS, 12 | * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | * See the License for the specific language governing permissions and 14 | * limitations under the License. 15 | */ 16 | 17 | #define SIGNAL_FOR_PROCESS_INTERRUPT SIGINT 18 | #ifndef SIGBUS 19 | #define SIGBUS 10 20 | #endif 21 | #ifndef CONTEXT_ALL 22 | #define CONTEXT_ALL (CONTEXT_CONTROL | CONTEXT_INTEGER | CONTEXT_SEGMENTS | CONTEXT_FLOATING_POINT | CONTEXT_DEBUG_REGISTERS | CONTEXT_EXTENDED_REGISTERS) 23 | #endif 24 | 25 | typedef struct { 26 | HANDLE h; 27 | OVERLAPPED *o; 28 | } pending_io; 29 | -------------------------------------------------------------------------------- /lisp-kernel/pad.s: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright 2016 Clozure Associates 3 | * 4 | * Licensed under the Apache License, Version 2.0 (the "License"); 5 | * you may not use this file except in compliance with the License. 6 | * You may obtain a copy of the License at 7 | * 8 | * http://www.apache.org/licenses/LICENSE-2.0 9 | * 10 | * Unless required by applicable law or agreed to in writing, software 11 | * distributed under the License is distributed on an "AS IS" BASIS, 12 | * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | * See the License for the specific language governing permissions and 14 | * limitations under the License. 15 | */ 16 | .globl openmcl_low_address 17 | openmcl_low_address: 18 | nop 19 | 20 | 21 | 22 | -------------------------------------------------------------------------------- /lisp-kernel/platform-androidarm.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright 1994-2010 Clozure Associates 3 | * 4 | * Licensed under the Apache License, Version 2.0 (the "License"); 5 | * you may not use this file except in compliance with the License. 6 | * You may obtain a copy of the License at 7 | * 8 | * http://www.apache.org/licenses/LICENSE-2.0 9 | * 10 | * Unless required by applicable law or agreed to in writing, software 11 | * distributed under the License is distributed on an "AS IS" BASIS, 12 | * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | * See the License for the specific language governing permissions and 14 | * limitations under the License. 15 | */ 16 | 17 | #define WORD_SIZE 32 18 | #define PLATFORM_OS PLATFORM_OS_ANDROID 19 | #define PLATFORM_CPU PLATFORM_CPU_ARM 20 | #define PLATFORM_WORD_SIZE PLATFORM_WORD_SIZE_32 21 | 22 | typedef struct ucontext ExceptionInformation; 23 | 24 | #define MAXIMUM_MAPPABLE_MEMORY ((3<<28)-(1<<16)) 25 | #define IMAGE_BASE_ADDRESS 0x50000000 26 | 27 | #include "lisptypes.h" 28 | #include "arm-constants.h" 29 | 30 | /* xp accessors */ 31 | #define xpGPRvector(x) ((natural *)&((x)->uc_mcontext.arm_r0)) 32 | #define xpGPR(x,gprno) (xpGPRvector(x))[gprno] 33 | #define xpPC(x) (*((pc*)(&(xpGPR(x,15))))) 34 | #define xpLR(x) (*((pc*)(&(xpGPR(x,14))))) 35 | #define xpPSR(x) xpGPR(x,16) 36 | #define xpFaultAddress(x) xpGPR(x,17) 37 | #define xpTRAP(x) xpGPR(x,-3) 38 | #define xpERROR(x) xpGPR(x,-2) 39 | #define xpFaultStatus(x) xpERROR(x) 40 | 41 | #define DarwinSigReturn(context) 42 | #define SIGRETURN(context) 43 | 44 | #include "os-linux.h" 45 | 46 | #define PROTECT_CSTACK 1 47 | 48 | /* Nonsense */ 49 | #define SYS_futex __NR_futex 50 | #define PTHREAD_DESTRUCTOR_ITERATIONS 1 51 | #define __fpurge(f) 52 | -------------------------------------------------------------------------------- /lisp-kernel/platform-darwinarm.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright 1994-2010 Clozure Associates 3 | * 4 | * Licensed under the Apache License, Version 2.0 (the "License"); 5 | * you may not use this file except in compliance with the License. 6 | * You may obtain a copy of the License at 7 | * 8 | * http://www.apache.org/licenses/LICENSE-2.0 9 | * 10 | * Unless required by applicable law or agreed to in writing, software 11 | * distributed under the License is distributed on an "AS IS" BASIS, 12 | * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | * See the License for the specific language governing permissions and 14 | * limitations under the License. 15 | */ 16 | 17 | #define WORD_SIZE 32 18 | #define PLATFORM_OS PLATFORM_OS_DARWIN 19 | #define PLATFORM_CPU PLATFORM_CPU_ARM 20 | #define PLATFORM_WORD_SIZE PLATFORM_WORD_SIZE_32 21 | 22 | #include 23 | #include 24 | 25 | typedef ucontext_t ExceptionInformation; 26 | 27 | #define MAXIMUM_MAPPABLE_MEMORY (256<<20) /* uh, no */ 28 | #define IMAGE_BASE_ADDRESS 0x04001000 29 | 30 | #include "lisptypes.h" 31 | #include "arm-constants.h" 32 | 33 | #define UC_MCONTEXT(UC) UC->uc_mcontext 34 | 35 | /* xp accessors */ 36 | #define xpGPRvector(x) ((natural *)&((x)->uc_mcontext->__ss.__r[0])) 37 | #define xpGPR(x,gprno) (xpGPRvector(x))[gprno] 38 | #define xpPC(x) (*((pc*)(&(xpGPR(x,15))))) 39 | #define xpLR(x) (*((pc*)(&(xpGPR(x,14))))) 40 | #define xpPSR(x) xpGPR(x,16) 41 | #define xpFaultAddress(x) ((x)->uc_mcontext->__es.__far) 42 | #define xpFaultStatus(x) ((x)->uc_mcontext->__es.__fsr) 43 | 44 | 45 | #define DarwinSigReturn(context) 46 | #define SIGRETURN(context) 47 | 48 | #include "os-darwin.h" 49 | 50 | -------------------------------------------------------------------------------- /lisp-kernel/platform-linuxarm.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright 1994-2010 Clozure Associates 3 | * 4 | * Licensed under the Apache License, Version 2.0 (the "License"); 5 | * you may not use this file except in compliance with the License. 6 | * You may obtain a copy of the License at 7 | * 8 | * http://www.apache.org/licenses/LICENSE-2.0 9 | * 10 | * Unless required by applicable law or agreed to in writing, software 11 | * distributed under the License is distributed on an "AS IS" BASIS, 12 | * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | * See the License for the specific language governing permissions and 14 | * limitations under the License. 15 | */ 16 | 17 | #define WORD_SIZE 32 18 | #define PLATFORM_OS PLATFORM_OS_LINUX 19 | #define PLATFORM_CPU PLATFORM_CPU_ARM 20 | #define PLATFORM_WORD_SIZE PLATFORM_WORD_SIZE_32 21 | 22 | #include 23 | 24 | typedef ucontext_t ExceptionInformation; 25 | 26 | #define MAXIMUM_MAPPABLE_MEMORY (3<<29) 27 | #define IMAGE_BASE_ADDRESS 0x10000000 28 | 29 | #include "lisptypes.h" 30 | #include "arm-constants.h" 31 | 32 | /* xp accessors */ 33 | #define xpGPRvector(x) ((natural *)&((x)->uc_mcontext.arm_r0)) 34 | #define xpGPR(x,gprno) (xpGPRvector(x))[gprno] 35 | #define xpPC(x) (*((pc*)(&(xpGPR(x,15))))) 36 | #define xpLR(x) (*((pc*)(&(xpGPR(x,14))))) 37 | #define xpPSR(x) ((x)->uc_mcontext.arm_cpsr) 38 | #define xpFaultAddress(x) ((x)->uc_mcontext.fault_address) 39 | #define xpTRAP(x) ((x)->uc_mcontext.trap_no) 40 | #define xpERROR(x) ((x)->uc_mcontext.error_code) 41 | #define xpFaultStatus(x) xpERROR(x) 42 | 43 | #define DarwinSigReturn(context) 44 | #define SIGRETURN(context) 45 | 46 | #include "os-linux.h" 47 | 48 | #define PROTECT_CSTACK 1 49 | 50 | -------------------------------------------------------------------------------- /lisp-kernel/platform-linuxx8632.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright 1994-2010 Clozure Associates 3 | * 4 | * Licensed under the Apache License, Version 2.0 (the "License"); 5 | * you may not use this file except in compliance with the License. 6 | * You may obtain a copy of the License at 7 | * 8 | * http://www.apache.org/licenses/LICENSE-2.0 9 | * 10 | * Unless required by applicable law or agreed to in writing, software 11 | * distributed under the License is distributed on an "AS IS" BASIS, 12 | * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | * See the License for the specific language governing permissions and 14 | * limitations under the License. 15 | */ 16 | 17 | #define WORD_SIZE 32 18 | #define PLATFORM_OS PLATFORM_OS_LINUX 19 | #define PLATFORM_CPU PLATFORM_CPU_X86 20 | #define PLATFORM_WORD_SIZE PLATFORM_WORD_SIZE_32 21 | 22 | #include 23 | 24 | typedef ucontext_t ExceptionInformation; 25 | 26 | #define MAXIMUM_MAPPABLE_MEMORY (9U<<28) 27 | #define IMAGE_BASE_ADDRESS 0x10000000 28 | 29 | #include "lisptypes.h" 30 | #include "x86-constants32.h" 31 | 32 | /* xp accessors */ 33 | #define xpGPRvector(x) ((natural *)(&((x)->uc_mcontext.gregs))) 34 | #define xpGPR(x,gprno) (xpGPRvector(x)[gprno]) 35 | #define set_xpGPR(x,gpr,new) xpGPR((x),(gpr)) = (natural)(new) 36 | #define xpPC(x) (xpGPR(x,Iip)) 37 | #define xpMMXreg(x,n) *((natural *)(&((x)->uc_mcontext.fpregs->_st[n]))) 38 | /* You're supposed to look at a magic field in the struct _fpstate 39 | to know if there is sse2 state present; we only run on systems 40 | with sse2, so we'll assume it's always there. */ 41 | #define xpMXCSR(xp) (((struct _fpstate *)((xp)->uc_mcontext.fpregs))->mxcsr) 42 | #define eflags_register(xp) xpGPR(xp,Iflags) 43 | #define SIGNUM_FOR_INTN_TRAP SIGSEGV 44 | #define IS_MAYBE_INT_TRAP(info,xp) ((xpGPR(xp,REG_TRAPNO)==0xd)&&((xpGPR(xp,REG_ERR)&7)==2)) 45 | #define IS_PAGE_FAULT(info,xp) (xpGPR(xp,REG_TRAPNO)==0xe) 46 | #define SIGRETURN(context) 47 | 48 | #include "os-linux.h" 49 | -------------------------------------------------------------------------------- /lisp-kernel/platform-linuxx8664.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright 1994-2010 Clozure Associates 3 | * 4 | * Licensed under the Apache License, Version 2.0 (the "License"); 5 | * you may not use this file except in compliance with the License. 6 | * You may obtain a copy of the License at 7 | * 8 | * http://www.apache.org/licenses/LICENSE-2.0 9 | * 10 | * Unless required by applicable law or agreed to in writing, software 11 | * distributed under the License is distributed on an "AS IS" BASIS, 12 | * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | * See the License for the specific language governing permissions and 14 | * limitations under the License. 15 | */ 16 | 17 | #define WORD_SIZE 64 18 | #define PLATFORM_OS PLATFORM_OS_LINUX 19 | #define PLATFORM_CPU PLATFORM_CPU_X86 20 | #define PLATFORM_WORD_SIZE PLATFORM_WORD_SIZE_64 21 | 22 | #include 23 | 24 | typedef ucontext_t ExceptionInformation; 25 | 26 | #define MAXIMUM_MAPPABLE_MEMORY (512L<<30L) 27 | #define IMAGE_BASE_ADDRESS 0x300000000000L 28 | 29 | #include "lisptypes.h" 30 | #include "x86-constants64.h" 31 | 32 | /* xp accessors */ 33 | #define xpGPRvector(x) ((natural *)(&((x)->uc_mcontext.gregs))) 34 | #define xpGPR(x,gprno) (xpGPRvector(x)[gprno]) 35 | #define set_xpGPR(x,gpr,new) xpGPR((x),(gpr)) = (natural)(new) 36 | #define xpPC(x) (xpGPR(x,Iip)) 37 | #define xpMMXreg(x,n) *((natural *)(&((x)->uc_mcontext.fpregs->_st[n]))) 38 | #define xpMXCSR(xp) ((xp)->uc_mcontext.fpregs->mxcsr) 39 | #define eflags_register(xp) xpGPR(xp,Iflags) 40 | #define SIGNUM_FOR_INTN_TRAP SIGSEGV 41 | #define IS_MAYBE_INT_TRAP(info,xp) ((xpGPR(xp,REG_TRAPNO)==0xd)&&((xpGPR(xp,REG_ERR)&7)==2)) 42 | #define IS_PAGE_FAULT(info,xp) (xpGPR(xp,REG_TRAPNO)==0xe) 43 | #define SIGRETURN(context) 44 | 45 | #include "os-linux.h" 46 | -------------------------------------------------------------------------------- /lisp-kernel/platform-solarisx64.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright 1994-2010 Clozure Associates 3 | * 4 | * Licensed under the Apache License, Version 2.0 (the "License"); 5 | * you may not use this file except in compliance with the License. 6 | * You may obtain a copy of the License at 7 | * 8 | * http://www.apache.org/licenses/LICENSE-2.0 9 | * 10 | * Unless required by applicable law or agreed to in writing, software 11 | * distributed under the License is distributed on an "AS IS" BASIS, 12 | * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | * See the License for the specific language governing permissions and 14 | * limitations under the License. 15 | */ 16 | 17 | #define WORD_SIZE 64 18 | #define PLATFORM_OS PLATFORM_OS_SOLARIS 19 | #define PLATFORM_CPU PLATFORM_CPU_X86 20 | #define PLATFORM_WORD_SIZE PLATFORM_WORD_SIZE_64 21 | 22 | typedef struct ucontext ExceptionInformation; 23 | 24 | #define MAXIMUM_MAPPABLE_MEMORY (512L<<30L) 25 | #define IMAGE_BASE_ADDRESS 0x300000000000L 26 | 27 | #include "lisptypes.h" 28 | #include "x86-constants64.h" 29 | 30 | #define xpGPRvector(x) ((x)->uc_mcontext.gregs) 31 | #define xpGPR(x,gprno) (xpGPRvector(x)[gprno]) 32 | #define set_xpGPR(x,gpr,new) xpGPR((x),(gpr)) = (natural)(new) 33 | #define xpPC(x) xpGPR(x,Iip) 34 | #define eflags_register(xp) xpGPR(xp,Iflags) 35 | #define xpXMMregs(x)(&((x)->uc_mcontext.fpregs.fp_reg_set.fpchip_state.xmm[0])) 36 | #define xpMXCSR(x) ((x)->uc_mcontext.fpregs.fp_reg_set.fpchip_state.mxcsr) 37 | #define SIGNUM_FOR_INTN_TRAP SIGSEGV 38 | #define IS_MAYBE_INT_TRAP(info,xp) ((xpGPR(xp,REG_TRAPNO)==0xd)&&((xpGPR(xp,REG_ERR)&7)==2)) 39 | #define IS_PAGE_FAULT(info,xp) (xpGPR(xp,REG_TRAPNO)==0xe) 40 | #define SIGRETURN(context) setcontext(context) 41 | 42 | #include "os-solaris.h" 43 | -------------------------------------------------------------------------------- /lisp-kernel/plprint.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright 1994-2009 Clozure Associates 3 | * 4 | * Licensed under the Apache License, Version 2.0 (the "License"); 5 | * you may not use this file except in compliance with the License. 6 | * You may obtain a copy of the License at 7 | * 8 | * http://www.apache.org/licenses/LICENSE-2.0 9 | * 10 | * Unless required by applicable law or agreed to in writing, software 11 | * distributed under the License is distributed on an "AS IS" BASIS, 12 | * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | * See the License for the specific language governing permissions and 14 | * limitations under the License. 15 | */ 16 | 17 | #include "lispdcmd.h" 18 | 19 | 20 | void 21 | plprint(ExceptionInformation *xp, LispObj obj) 22 | { 23 | if (lisp_nil == (LispObj) NULL) { 24 | fprintf(dbgout,"can't find lisp NIL; lisp process not active process ?\n"); 25 | } else { 26 | Dprintf("\n%s", print_lisp_object(obj)); 27 | } 28 | } 29 | 30 | -------------------------------------------------------------------------------- /lisp-kernel/ppc-constants.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright 1994-2009 Clozure Associates 3 | * 4 | * Licensed under the Apache License, Version 2.0 (the "License"); 5 | * you may not use this file except in compliance with the License. 6 | * You may obtain a copy of the License at 7 | * 8 | * http://www.apache.org/licenses/LICENSE-2.0 9 | * 10 | * Unless required by applicable law or agreed to in writing, software 11 | * distributed under the License is distributed on an "AS IS" BASIS, 12 | * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | * See the License for the specific language governing permissions and 14 | * limitations under the License. 15 | */ 16 | 17 | #include "constants.h" 18 | 19 | /* Register usage: */ 20 | #define rzero 0 21 | #define sp 1 22 | #define linux_sys_reg 2 /* volatile reg on Darwin ; thread ptr on Linux32, TOC on 23 | Linux64. */ 24 | #define imm0 3 25 | #define imm1 4 26 | #define imm2 5 27 | #define imm3 6 28 | #define imm4 7 29 | #define imm5 8 30 | #define allocptr 9 31 | #define allocbase 10 32 | #define nargs 11 33 | #define tsp 12 34 | #define loc_pc 14 /* code vector locative */ 35 | #define vsp 15 36 | #define fn 16 37 | #define temp3 17 38 | #define temp2 18 39 | #define temp1 19 40 | #define temp0 20 41 | #define arg_x 21 42 | #define arg_y 22 43 | #define arg_z 23 44 | #define save7 24 45 | #define save6 25 46 | #define save5 26 47 | #define save4 27 48 | #define save3 28 49 | #define save2 29 50 | #define save1 30 51 | #define save0 31 52 | 53 | #define vfp save0 /* frame pointer if needed (stack consing). */ 54 | #define fname temp3 55 | #define nfn temp2 56 | #define next_method_context temp1 57 | #define closure_data temp0 58 | 59 | 60 | #define BA_MASK ((unsigned) ((-1<<26) | (1<<1))) 61 | #define BA_VAL ((unsigned) ((18<<26) | (1<<1))) 62 | 63 | 64 | #define STATIC_BASE_ADDRESS 0x00002000 65 | 66 | 67 | 68 | -------------------------------------------------------------------------------- /lisp-kernel/probes.d: -------------------------------------------------------------------------------- 1 | provider ccl { 2 | probe gc__start(unsigned long); 3 | probe gc__finish(unsigned long); 4 | probe egc__start(unsigned long, unsigned); 5 | probe egc__finish(unsigned long, unsigned); 6 | probe create__thread(unsigned long); 7 | }; 8 | 9 | /* 10 | gc-start(bytes_allocated) 11 | gc-finish(bytes-freed) 12 | egc-start(bytes-allocated, generation) 13 | egc-finish(bytes-freed, generation) 14 | create-thread(thread-id) 15 | */ 16 | -------------------------------------------------------------------------------- /lisp-kernel/solarisx64/.gdbinit: -------------------------------------------------------------------------------- 1 | define x86_lisp_string 2 | x/s $arg0-5 3 | end 4 | 5 | define gtra 6 | br *$r10 7 | cont 8 | end 9 | 10 | define x86pname 11 | set $temp=*((long *)((long)($arg0-6))) 12 | x86_lisp_string $temp 13 | end 14 | 15 | 16 | define pname 17 | x86pname $arg0 18 | end 19 | 20 | define l 21 | call print_lisp_object($arg0) 22 | end 23 | 24 | define lw 25 | l $r13 26 | end 27 | 28 | define clobber_breakpoint 29 | set *(short *)($pc-2)=0x9090 30 | end 31 | 32 | define arg_z 33 | l $rsi 34 | end 35 | 36 | define arg_y 37 | l $rdi 38 | end 39 | 40 | define arg_x 41 | l $r8 42 | end 43 | 44 | define bx 45 | l $rbx 46 | end 47 | 48 | define showlist 49 | set $l=$arg0 50 | while $l != 0x200b 51 | set $car = *((LispObj *)($l+5)) 52 | set $l = *((LispObj *)($l-3)) 53 | l $car 54 | end 55 | end 56 | 57 | define lbt 58 | call plbt_sp($rbp) 59 | end 60 | 61 | define ada 62 | p/x *(all_areas->succ) 63 | end 64 | 65 | define lregs 66 | call debug_lisp_registers($arg0,0,0) 67 | end 68 | 69 | break Bug 70 | 71 | display/i $pc 72 | 73 | handle SIGKILL pass nostop noprint 74 | handle SIGILL pass nostop noprint 75 | handle SIGSEGV pass nostop noprint 76 | handle SIGBUS pass nostop noprint 77 | handle SIGFPE pass nostop noprint 78 | handle SIGUSR1 pass nostop noprint 79 | handle SIGUSR2 pass nostop noprint 80 | handle SIGPWR pass nostop noprint 81 | handle SIGQUIT pass nostop noprint 82 | 83 | -------------------------------------------------------------------------------- /lisp-kernel/static-linuxppc/ccl-platform.h: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/Clozure/ccl/da7138ef6e1924c9318f133ad0dc9002d51f880d/lisp-kernel/static-linuxppc/ccl-platform.h -------------------------------------------------------------------------------- /lisp-kernel/static-linuxppc/staticlib.c: -------------------------------------------------------------------------------- 1 | typedef struct { 2 | char *name; 3 | void *(*func)(); 4 | } external_function; 5 | 6 | #define NULL ((void *)0) 7 | #include "external-functions.h" 8 | 9 | int 10 | string_compare(char *a, char *b) 11 | { 12 | char ch; 13 | 14 | while (ch = *a++) { 15 | if (*b++ != ch) { 16 | return 1; 17 | } 18 | } 19 | return !!*b; 20 | } 21 | 22 | 23 | void * 24 | dlsym(void *handle, char *name) 25 | { 26 | external_function *p; 27 | char *fname; 28 | 29 | for (p = external_functions; fname = p->name; p++) { 30 | if (!string_compare(name, fname)) { 31 | return (void *)(p->func); 32 | } 33 | } 34 | return NULL; 35 | } 36 | 37 | void * 38 | dlopen(char *path, int mode) 39 | { 40 | return NULL; 41 | } 42 | 43 | void * 44 | dlerror() 45 | { 46 | return (void *)"No shared library support\n"; 47 | } 48 | 49 | void * 50 | dlclose() 51 | { 52 | return NULL; 53 | } 54 | -------------------------------------------------------------------------------- /lisp-kernel/win32/.gdbinit: -------------------------------------------------------------------------------- 1 | directory lisp-kernel 2 | 3 | define pl 4 | call print_lisp_object($arg0) 5 | end 6 | 7 | define showlist 8 | set $l=$arg0 9 | while $l != 0x3001 10 | set $car = *((LispObj *)($l+3)) 11 | set $l = *((LispObj *)($l-1)) 12 | pl $car 13 | end 14 | end 15 | 16 | 17 | define fn 18 | pl $edi 19 | end 20 | 21 | define arg_y 22 | pl $esi 23 | end 24 | 25 | define arg_z 26 | pl $ebx 27 | end 28 | 29 | define offset 30 | p (int)$pc-$edi 31 | end 32 | 33 | 34 | break Bug 35 | break FBug 36 | 37 | display/i $pc 38 | 39 | handle SIGKILL pass nostop noprint 40 | handle SIGILL pass nostop noprint 41 | handle SIGSEGV pass nostop noprint 42 | handle SIGBUS pass nostop noprint 43 | handle SIGFPE pass nostop noprint 44 | handle SIGUSR1 pass nostop noprint 45 | handle SIGUSR2 pass nostop noprint 46 | handle SIGEMT pass nostop noprint 47 | # Work around apparent Apple GDB bug 48 | handle SIGTTIN nopass nostop noprint 49 | # Work around Leopard bug du jour 50 | handle SIGSYS pass nostop noprint 51 | 52 | -------------------------------------------------------------------------------- /lisp-kernel/win32/win32-foreign-thread-support.c: -------------------------------------------------------------------------------- 1 | #include "../threads.h" 2 | 3 | typedef void(*shutdownfunc)(void *); 4 | 5 | shutdownfunc shutdown_thread_tcr = NULL; 6 | 7 | void *__declspec(dllexport) 8 | prepare_foreign_threads() 9 | { 10 | void *addr = GetProcAddress(NULL, "shutdown_thread_tcr"); 11 | shutdown_thread_tcr = (shutdownfunc)addr; 12 | return addr; 13 | } 14 | 15 | BOOL WINAPI 16 | DllMain(HINSTANCE hinstDLL, 17 | DWORD fdwReason, 18 | LPVOID lpvReserved) 19 | { 20 | TCR *tcr; 21 | 22 | switch (fdwReason) { 23 | case DLL_THREAD_DETACH: 24 | if (shutdown_thread_tcr) { 25 | tcr = ((TCR *)((char *)NtCurrentTeb() + TCR_BIAS))->linear; 26 | if (tcr && (tcr->flags & (1<succ) 65 | end 66 | 67 | define lregs 68 | call debug_lisp_registers($arg0,0,0) 69 | end 70 | 71 | break Bug 72 | 73 | display/i $pc 74 | 75 | handle SIGKILL pass nostop noprint 76 | handle SIGILL pass nostop noprint 77 | handle SIGSEGV pass nostop noprint 78 | handle SIGBUS pass nostop noprint 79 | handle SIGFPE pass nostop noprint 80 | handle SIG40 pass nostop noprint 81 | handle SIG41 pass nostop noprint 82 | handle SIG42 pass nostop noprint 83 | handle SIGPWR pass nostop noprint 84 | handle SIGQUIT pass nostop noprint 85 | 86 | -------------------------------------------------------------------------------- /lisp-kernel/win64/yasm-redefinition.patch: -------------------------------------------------------------------------------- 1 | Index: libyasm/symrec.c 2 | =================================================================== 3 | --- libyasm/symrec.c (revision 2037) 4 | +++ libyasm/symrec.c (working copy) 5 | @@ -281,10 +281,15 @@ 6 | yasm_symtab_define_equ(yasm_symtab *symtab, const char *name, yasm_expr *e, 7 | unsigned long line) 8 | { 9 | - yasm_symrec *rec = symtab_define(symtab, name, SYM_EQU, 1, line); 10 | + yasm_symrec *rec = yasm_symtab_get(symtab, name); 11 | + if (rec) { 12 | + /* redefinition. Emit warning here. */ 13 | + } else { 14 | + rec = symtab_define(symtab, name, SYM_EQU, 1, line); 15 | + } 16 | if (yasm_error_occurred()) 17 | return rec; 18 | - rec->value.expn = e; 19 | + rec->value.expn = yasm_expr_simplify(e, 1); 20 | rec->status |= YASM_SYM_VALUED; 21 | return rec; 22 | } 23 | -------------------------------------------------------------------------------- /lisp-kernel/x86-utils.c: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright 2011 Clozure Associates 3 | * 4 | * Licensed under the Apache License, Version 2.0 (the "License"); 5 | * you may not use this file except in compliance with the License. 6 | * You may obtain a copy of the License at 7 | * 8 | * http://www.apache.org/licenses/LICENSE-2.0 9 | * 10 | * Unless required by applicable law or agreed to in writing, software 11 | * distributed under the License is distributed on an "AS IS" BASIS, 12 | * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | * See the License for the specific language governing permissions and 14 | * limitations under the License. 15 | */ 16 | 17 | #include "lisp.h" 18 | #include "x86-utils.h" 19 | 20 | LispObj 21 | tra_function(LispObj tra) 22 | { 23 | LispObj f = 0; 24 | 25 | #ifdef X8664 26 | if (tag_of(tra) == tag_tra) { 27 | if ((*((unsigned short *)tra) == RECOVER_FN_FROM_RIP_WORD0) && 28 | (*((unsigned char *)(tra + 2)) == RECOVER_FN_FROM_RIP_BYTE2)) { 29 | int sdisp = (*(int *)(tra + RECOVER_FN_FROM_RIP_DISP_OFFSET)); 30 | f = RECOVER_FN_FROM_RIP_LENGTH + tra + sdisp; 31 | } 32 | } 33 | #else 34 | if (fulltag_of(tra) == fulltag_tra) { 35 | if (*((unsigned char *)tra) == RECOVER_FN_OPCODE) { 36 | natural n = *((natural *)(tra + 1)); 37 | f = (LispObj)n; 38 | } 39 | } 40 | #endif 41 | return f; 42 | } 43 | 44 | int 45 | tra_offset(LispObj tra) 46 | { 47 | LispObj f = tra_function(tra); 48 | int disp = 0; 49 | 50 | if (functionp(f)) 51 | disp = tra - f; 52 | return disp; 53 | } 54 | 55 | int 56 | ptr_in_area(char *p, area *a) 57 | { 58 | return a->low <= p && a->high > p; 59 | } 60 | 61 | area * 62 | in_any_consing_area(LispObj thing) 63 | { 64 | area *a = all_areas->succ; 65 | char *p = (char *)thing; 66 | 67 | while (a != all_areas) { 68 | area_code code = a->code; 69 | if (code == AREA_READONLY || code == AREA_WATCHED || 70 | code == AREA_MANAGED_STATIC || code == AREA_STATIC || 71 | code == AREA_DYNAMIC) { 72 | if (a->low <= p && p < a->high) 73 | return a; 74 | } 75 | a = a->succ; 76 | } 77 | return NULL; 78 | } 79 | -------------------------------------------------------------------------------- /lisp-kernel/x86-utils.h: -------------------------------------------------------------------------------- 1 | /* 2 | * Copyright 2011 Clozure Associates 3 | * 4 | * Licensed under the Apache License, Version 2.0 (the "License"); 5 | * you may not use this file except in compliance with the License. 6 | * You may obtain a copy of the License at 7 | * 8 | * http://www.apache.org/licenses/LICENSE-2.0 9 | * 10 | * Unless required by applicable law or agreed to in writing, software 11 | * distributed under the License is distributed on an "AS IS" BASIS, 12 | * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | * See the License for the specific language governing permissions and 14 | * limitations under the License. 15 | */ 16 | 17 | #ifndef X86_UTILS_H 18 | #define X86_UTILS_H 19 | 20 | extern LispObj tra_function(LispObj tra); 21 | extern int tra_offset(LispObj tra); 22 | extern int ptr_in_area(char *p, area* a); 23 | extern area *in_any_consing_area(LispObj thing); 24 | 25 | static inline LispObj 26 | function_to_function_vector(LispObj f) 27 | { 28 | #ifdef X8664 29 | return f - fulltag_function + fulltag_misc; 30 | #else 31 | return f; 32 | #endif 33 | } 34 | 35 | static inline int 36 | tra_p(LispObj thing) 37 | { 38 | #ifdef X8664 39 | return tag_of(thing) == tag_tra; 40 | #else 41 | return fulltag_of(thing) == fulltag_tra; 42 | #endif 43 | } 44 | 45 | static inline int 46 | functionp(LispObj f) 47 | { 48 | #ifdef X8664 49 | return fulltag_of(f) == fulltag_function; 50 | #else 51 | return fulltag_of(f) == fulltag_misc && 52 | header_subtag(header_of(f)) == subtag_function; 53 | #endif 54 | } 55 | 56 | #endif 57 | -------------------------------------------------------------------------------- /mac-ui/libdispatch.lisp: -------------------------------------------------------------------------------- 1 | ;;; 2 | ;;; Copyright 2016 Clozure Associates 3 | ;;; 4 | ;;; Licensed under the Apache License, Version 2.0 (the "License"); 5 | ;;; you may not use this file except in compliance with the License. 6 | ;;; You may obtain a copy of the License at 7 | ;;; 8 | ;;; http://www.apache.org/licenses/LICENSE-2.0 9 | ;;; 10 | ;;; Unless required by applicable law or agreed to in writing, software 11 | ;;; distributed under the License is distributed on an "AS IS" BASIS, 12 | ;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | ;;; See the License for the specific language governing permissions and 14 | ;;; limitations under the License. 15 | (in-package "CCL") 16 | 17 | (defstatic *dispatch-id-map* (make-id-map)) 18 | (defloadvar *dispatch-main-queue* (foreign-symbol-address "_dispatch_main_q")) 19 | 20 | (defcallback %dispatch-callback (:address context :void) 21 | ;; We cannot throw out of here. If we do, libdispatch will get very 22 | ;; confused. 23 | (with-simple-restart (abort "Return from libdispatch callback") 24 | (let* ((n (%ptr-to-int context)) 25 | (thunk (id-map-free-object *dispatch-id-map* n))) 26 | (funcall thunk)))) 27 | 28 | (defun dispatch-async (queue thunk) 29 | (let ((n (assign-id-map-id *dispatch-id-map* thunk))) 30 | (external-call "dispatch_async_f" :address queue :address (%int-to-ptr n) 31 | :address %dispatch-callback :void))) 32 | 33 | (defun dispatch-sync (queue thunk) 34 | (let ((n (assign-id-map-id *dispatch-id-map* thunk))) 35 | (external-call "dispatch_sync_f" :address queue :address (%int-to-ptr n) 36 | :address %dispatch-callback :void))) 37 | -------------------------------------------------------------------------------- /mac-ui/package.lisp: -------------------------------------------------------------------------------- 1 | ;;; 2 | ;;; Copyright 2016 Clozure Associates 3 | ;;; 4 | ;;; Licensed under the Apache License, Version 2.0 (the "License"); 5 | ;;; you may not use this file except in compliance with the License. 6 | ;;; You may obtain a copy of the License at 7 | ;;; 8 | ;;; http://www.apache.org/licenses/LICENSE-2.0 9 | ;;; 10 | ;;; Unless required by applicable law or agreed to in writing, software 11 | ;;; distributed under the License is distributed on an "AS IS" BASIS, 12 | ;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 13 | ;;; See the License for the specific language governing permissions and 14 | ;;; limitations under the License. 15 | (cl:defpackage "MAC-UI" 16 | (:use "CL" "CCL") 17 | (:export 18 | "OBJC-OBJECT" "OBJC-OBJECT-WRAPPER")) 19 | 20 | -------------------------------------------------------------------------------- /objc-bridge/obsolete/README: -------------------------------------------------------------------------------- 1 | The Objective-C bridge has evolved quite a bit, and the CocoaBridgeDoc.txt 2 | file is now probably mostly misleading. 3 | 4 | The most current documentation for the bridge is in release-notes.txt in 5 | the top-level ccl directory. At some point soon, updated documentation 6 | will be made available at: 7 | 8 | http://doc.clozure.com/doku.php/doc/openmcl/objc 9 | 10 | -------------------------------------------------------------------------------- /scripts/ccl: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | # Change the definition of CCL_DEFAULT_DIRECTORY below to refer to 4 | # your Clozure CL installation directory. The lisp will use this 5 | # environment variable to set up translations for the CCL: logical 6 | # host. 7 | 8 | # Any definition of CCL_DEFAULT_DIRECTORY already present in the 9 | # environment takes precedence over definition made below. 10 | 11 | if [ -z "$CCL_DEFAULT_DIRECTORY" ]; then 12 | CCL_DEFAULT_DIRECTORY=/usr/local/src/ccl 13 | fi 14 | 15 | # If you don't want to guess the name of the lisp kernel on 16 | # every invocation (or if you want to use a kernel with a 17 | # non-default name), you might want to uncomment and change 18 | # the following line: 19 | #OPENMCL_KERNEL=some_name 20 | 21 | if [ -z "$OPENMCL_KERNEL" ]; then 22 | case `uname -s` in 23 | Darwin) case `arch` in 24 | ppc*) OPENMCL_KERNEL=dppccl ;; 25 | i386) OPENMCL_KERNEL=dx86cl ;; 26 | esac ;; 27 | Linux) case `uname -m` in 28 | ppc*) OPENMCL_KERNEL=ppccl ;; 29 | *86*) OPENMCL_KERNEL=lx86cl ;; 30 | *arm*) OPENMCL_KERNEL=armcl ;; 31 | *aarch64*) OPENMCL_KERNEL=armcl ;; 32 | esac ;; 33 | CYGWIN*) 34 | OPENMCL_KERNEL=wx86cl.exe 35 | CCL_DEFAULT_DIRECTORY="C:/cygwin$CCL_DEFAULT_DIRECTORY" 36 | ;; 37 | SunOS) OPENMCL_KERNEL=sx86cl 38 | ;; 39 | FreeBSD) OPENMCL_KERNEL=fx86cl 40 | ;; 41 | *) 42 | echo "Can't determine host OS. Fix this." 43 | exit 1 44 | ;; 45 | esac 46 | fi 47 | 48 | export CCL_DEFAULT_DIRECTORY 49 | exec ${CCL_DEFAULT_DIRECTORY}/${OPENMCL_KERNEL} "$@" 50 | 51 | -------------------------------------------------------------------------------- /scripts/ccl64: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # 3 | # Change the definition of CCL_DEFAULT_DIRECTORY below to refer to 4 | # your Clozure CL installation directory. The lisp will use this 5 | # environment variable to set up translations for the CCL: logical 6 | # host. 7 | 8 | # Any definition of CCL_DEFAULT_DIRECTORY already present in the 9 | # environment takes precedence over definition made below. 10 | 11 | if [ -z "$CCL_DEFAULT_DIRECTORY" ]; then 12 | CCL_DEFAULT_DIRECTORY=/usr/local/src/ccl 13 | fi 14 | 15 | # If you don't want to guess the name of the OpenMCL kernel on 16 | # every invocation (or if you want to use a kernel with a 17 | # non-default name), you might want to uncomment and change 18 | # the following line: 19 | #OPENMCL_KERNEL=some_name 20 | 21 | if [ -z "$OPENMCL_KERNEL" ]; then 22 | case `uname -s` in 23 | Darwin) 24 | case `arch` in 25 | ppc*) 26 | OPENMCL_KERNEL=dppccl64 27 | ;; 28 | i386|x86_64) 29 | OPENMCL_KERNEL=dx86cl64 30 | ;; 31 | esac 32 | ;; 33 | Linux) 34 | case `uname -m` in 35 | ppc64) 36 | OPENMCL_KERNEL=ppccl64 37 | ;; 38 | x86_64) 39 | OPENMCL_KERNEL=lx86cl64 40 | ;; 41 | *) 42 | echo "Can't determine machine architecture. Fix this." 43 | exit 1 44 | ;; 45 | esac 46 | ;; 47 | FreeBSD) 48 | case `uname -m` in 49 | amd64) 50 | OPENMCL_KERNEL=fx86cl64 51 | ;; 52 | *) 53 | echo "unsupported architecture" 54 | exit 1 55 | ;; 56 | esac 57 | ;; 58 | SunOS) 59 | case `uname -m` in 60 | i86pc) 61 | OPENMCL_KERNEL=sx86cl64 62 | ;; 63 | *) 64 | echo "unsupported architecture" 65 | exit 1 66 | ;; 67 | esac 68 | ;; 69 | CYGWIN*) 70 | OPENMCL_KERNEL=wx86cl64.exe 71 | CCL_DEFAULT_DIRECTORY="C:/cygwin$CCL_DEFAULT_DIRECTORY" 72 | ;; 73 | *) 74 | echo "Can't determine host OS. Fix this." 75 | exit 1 76 | ;; 77 | esac 78 | fi 79 | 80 | export CCL_DEFAULT_DIRECTORY 81 | exec ${CCL_DEFAULT_DIRECTORY}/${OPENMCL_KERNEL} "$@" 82 | 83 | -------------------------------------------------------------------------------- /scripts/get-binaries: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # Use: 4 | # 1. check out source directly with 5 | # svn://svn.clozure.com/openmcl/trunk/source ccl 6 | # 2. cd ccl 7 | # 3. scripts/get-binaries linuxx86 8 | # 9 | # This way, you don't have to deal with svn externals. 10 | 11 | #dir="$(cd "$(dirname "${BASH_SOURCE[0]}")" && pwd -P )" 12 | 13 | case $1 in 14 | linuxx86) 15 | platform="linuxx86" 16 | image32="lx86cl.image" 17 | image64="lx86cl64.image" 18 | headers32="x86-headers" 19 | headers64="x86-headers64" 20 | ;; 21 | darwinx86) 22 | platform="darwinx86" 23 | image32="dx86cl.image" 24 | image64="dx86cl64.image" 25 | headers32="darwin-x86-headers" 26 | headers64="darwin-x86-headers64" 27 | ;; 28 | freebsdx86) 29 | platform="freebsdx86" 30 | image32="fx86cl.image" 31 | image64="fx86cl64.image" 32 | headers32="freebsd-headers" 33 | headers64="freebsd-headers64" 34 | ;; 35 | solarisx86) 36 | platform="solarisx86" 37 | image32="sx86cl.image" 38 | image64="sx86cl64.image" 39 | headers32="solarisx86-headers" 40 | headers64="solarisx64-headers" 41 | ;; 42 | windows) 43 | platform="windows" 44 | image32="wx86cl.image" 45 | image64="wx86cl64.image" 46 | headers32="win32-headers" 47 | headers64="win64-headers" 48 | ;; 49 | linuxarm) 50 | platform="linuxarm" 51 | image32="armcl.image" 52 | headers32="arm-headers" 53 | ;; 54 | *) 55 | echo "Usage: $0 linuxx86|darwinx86|freebsdx86|solarisx86|windows|linuxarm" 56 | exit 1 57 | ;; 58 | esac 59 | 60 | if [ "x$image64" != "x" ]; then 61 | echo fetching $image64 62 | svn export svn://svn.clozure.com/openmcl/trunk/$platform/ccl/$image64 63 | else 64 | echo no 64-bit image for $platform 65 | fi 66 | 67 | if [ "x$headers64" != "x" ]; then 68 | svn export svn://svn.clozure.com/openmcl/trunk/$headers64 69 | else 70 | echo no 64-bit headers for $platform 71 | fi 72 | 73 | echo fetching $image32 74 | svn export http://svn.clozure.com/publicsvn/openmcl/trunk/$platform/ccl/$image32 75 | svn export http://svn.clozure.com/publicsvn/openmcl/trunk/$headers32 76 | 77 | 78 | -------------------------------------------------------------------------------- /scripts/http-to-ssh: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | # This script can be used to rewrite the schema in svn working copy URLs, 4 | # changing URLs that use 'http' as an access method to use 'svn+ssh' instead. 5 | # (The http: access method allows read-only access; 'svn+ssh' allows people 6 | # with appropriate permission to commit changes to the repository.) 7 | 8 | SCRIPTS=`dirname $0` 9 | CCLDIR=$SCRIPTS/.. 10 | 11 | # This assumes that all directories under CCL are under svn control 12 | # That's a reasonable assumption after a fresh checkout; if it's 13 | # violated, svn will warn and we'll move on. 14 | 15 | for d in `ls $CCLDIR` 16 | do 17 | if [ -d $CCLDIR/$d ]; then 18 | $SCRIPTS/svn-switch $CCLDIR/$d 19 | fi 20 | done 21 | -------------------------------------------------------------------------------- /scripts/http-to-svn: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | # This script can be used to rewrite the schema in svn working copy URLs, 4 | # changing URLs that use 'http' as an access method to use 'svn' instead. 5 | # (The http: access method allows read-only access; 'svn' allows people 6 | # with appropriate permission to commit changes to the repository.) 7 | 8 | SCRIPTS=`dirname $0` 9 | CCLDIR=$SCRIPTS/.. 10 | 11 | # This assumes that all directories under CCL are under svn control 12 | # That's a reasonable assumption after a fresh checkout; if it's 13 | # violated, svn will warn and we'll move on. 14 | 15 | http_root=http://svn.clozure.com/publicsvn/openmcl 16 | svn_root=svn://svn.clozure.com/openmcl 17 | 18 | for d in `ls $CCLDIR` 19 | do 20 | if [ -d $CCLDIR/$d ]; then 21 | echo relocating $d 22 | (cd $d && svn switch --relocate $http_root $svn_root) 23 | fi 24 | done 25 | -------------------------------------------------------------------------------- /scripts/make-standalone-app: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | # Clozure CL.app has already been built with :standalone-app # on *features* 4 | 5 | ccl=~/ccl 6 | app="$ccl/Clozure CL.app" 7 | target="$app/Contents/Resources/ccl" 8 | 9 | mkdir "$target" 10 | ( cd "$ccl/lisp-kernel/darwinx8664" && make clean ) 11 | ( cd "$ccl/lisp-kernel/darwinx8632" && make clean ) 12 | ( cd "$ccl/cocoa-ide/altconsole" && make clean && rm -rf AltConsole.app ) 13 | 14 | for i in cocoa-ide compiler darwin-x86-headers64 doc examples level-0 level-1 lib library lisp-kernel objc-bridge scripts tools xdump; do 15 | cp -Rp "$ccl/$i" "$target" 16 | # we want the fasls for tools/, mainly because asdf.lisp is slow 17 | # to load from source 18 | if test "$i" != tools; then 19 | find "$target/$i" -type f -name "*.*fsl" -exec rm -rf {} \; 20 | fi 21 | done 22 | 23 | find "$app" -type d -name .svn -exec rm -rf {} \; 24 | 25 | codesign -s "3rd Party Mac Developer Application: Clozure Associates, LLC" "$app/Contents/Resources/AltConsole.app" 26 | codesign -s "3rd Party Mac Developer Application: Clozure Associates, LLC" "$app" 27 | 28 | -------------------------------------------------------------------------------- /scripts/make-store-app: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | 3 | ccl=/usr/local/src/ccl 4 | app="$ccl/Clozure CL.app" 5 | target="$app/Contents/Resources/ccl" 6 | 7 | mkdir "$target" 8 | ( cd "$ccl/lisp-kernel/darwinx8664" && make clean ) 9 | ( cd "$ccl/lisp-kernel/darwinx8632" && make clean ) 10 | ( cd "$ccl/cocoa-ide/altconsole" && make clean && rm -rf AltConsole.app ) 11 | 12 | for i in cocoa-ide compiler darwin-x86-headers64 doc examples level-0 level-1 lib library lisp-kernel objc-bridge scripts tools xdump; do 13 | cp -Rp "$ccl/$i" "$target" 14 | # we want the fasls for tools/, mainly because asdf.lisp is slow 15 | # to load from source 16 | if test "$i" != tools; then 17 | find "$target/$i" -type f -name "*.*fsl" -exec rm -rf {} \; 18 | fi 19 | done 20 | 21 | find "$app" -type d -name .svn -exec rm -rf {} \; 22 | 23 | codesign -s "3rd Party Mac Developer Application: Clozure Associates, LLC" "$app/Contents/Resources/AltConsole.app" 24 | codesign -s "3rd Party Mac Developer Application: Clozure Associates, LLC" "$app" 25 | productbuild --component "$app" /Applications --sign "3rd Party Mac Developer Installer: Clozure Associates, LLC" "$ccl/ccl.pkg" 26 | 27 | -------------------------------------------------------------------------------- /scripts/makedmg: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # 3 | # Creates a compresses disk image from the current directory 4 | # The resulting dmg file is placed in the parent directory 5 | # 6 | # This script first deletes any fasl files "*fsl" 7 | # 8 | # The volume name of the disk image is the final component 9 | # of the current directory name. 10 | # The file name is the same with ".dmg" appended. 11 | 12 | DIRNAME=${PWD##*/} 13 | 14 | find . -name "*fsl" -exec rm -f {} \; 15 | hdiutil create -fs HFS+ -srcfolder . -volname ${DIRNAME} ../${DIRNAME}x.dmg 16 | hdiutil convert ../${DIRNAME}x.dmg -format UDBZ -o ../${DIRNAME}.dmg 17 | rm ../${DIRNAME}x.dmg 18 | -------------------------------------------------------------------------------- /scripts/svn-switch: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | HTTP_URL=http://svn.clozure.com 3 | SSH_URL=svn+ssh://svn.clozure.com/usr/local 4 | 5 | (cd $1; 6 | echo Relocating `pwd` ; 7 | svn switch --relocate $HTTP_URL $SSH_URL) 8 | 9 | -------------------------------------------------------------------------------- /tools/README.txt: -------------------------------------------------------------------------------- 1 | This directory contains various third-party system-building tools. 2 | 3 | It is possible that more recent versions of this software may be 4 | availabe from the web sites of the originating projects. 5 | 6 | "asdf.lisp" is Another System Definition Facility. It is available 7 | from . It hooks into CCL's 8 | existing CL:REQUIRE function. 9 | 10 | "defsystem.lisp" is part of the clocc project on SourceForge: 11 | . It's a "system definition 12 | facility" which provides functionality similar to that offered by the 13 | Unix "make" program. It was originally written by Mark Kantrowitz and 14 | has been maintained and enhanced by many people; I believe that Marco 15 | Antoniotti was the last maintainer. This is version 3.4i of DEFSYSTEM 16 | (which is often called "MK-DEFSYSTEM"). Note that, for historical 17 | reasons, DEFSYSTEM will try to redefine the CL:REQUIRE function. 18 | -------------------------------------------------------------------------------- /tools/advice-profiler/package.lisp: -------------------------------------------------------------------------------- 1 | ;;; -*- Lisp -*- 2 | ;;; 3 | ;;; Copyright 2008 Hans Huebner 4 | ;;; 5 | ;;; Licensed under the Apache License, Version 2.0 (the "License"); 6 | ;;; you may not use this file except in compliance with the License. 7 | ;;; You may obtain a copy of the License at 8 | ;;; 9 | ;;; http://www.apache.org/licenses/LICENSE-2.0 10 | ;;; 11 | ;;; Unless required by applicable law or agreed to in writing, software 12 | ;;; distributed under the License is distributed on an "AS IS" BASIS, 13 | ;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | ;;; See the License for the specific language governing permissions and 15 | ;;; limitations under the License. 16 | 17 | (in-package "CL-USER") 18 | 19 | (defpackage "PROFILER" 20 | (:nicknames "PROF") 21 | (:use "COMMON-LISP" "CCL") 22 | (:export "PROFILE" "UNPROFILE" 23 | "UNPROFILE-ALL" 24 | "PROFILE-PACKAGE" "UNPROFILE-PACKAGE" 25 | "ENABLE-PROFILING" "DISABLE-PROFILING" 26 | "PROCESS-ENABLE-PROFILING" "PROCESS-DISABLE-PROFILING" 27 | "RESET" 28 | "REPORT")) 29 | -------------------------------------------------------------------------------- /tools/advice-profiler/profiler.asd: -------------------------------------------------------------------------------- 1 | ;;; -*- Lisp -*- 2 | ;;; 3 | ;;; Copyright 2008 Hans Huebner 4 | ;;; 5 | ;;; Licensed under the Apache License, Version 2.0 (the "License"); 6 | ;;; you may not use this file except in compliance with the License. 7 | ;;; You may obtain a copy of the License at 8 | ;;; 9 | ;;; http://www.apache.org/licenses/LICENSE-2.0 10 | ;;; 11 | ;;; Unless required by applicable law or agreed to in writing, software 12 | ;;; distributed under the License is distributed on an "AS IS" BASIS, 13 | ;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. 14 | ;;; See the License for the specific language governing permissions and 15 | ;;; limitations under the License. 16 | 17 | (in-package "CL-USER") 18 | 19 | (defpackage "PROFILER-SYSTEM" 20 | (:use "CL" "ASDF")) 21 | 22 | (in-package "PROFILER-SYSTEM") 23 | 24 | (defsystem :profiler 25 | :name "Clozure CL deterministic multithread-profiler" 26 | :author "Hans Huebner " 27 | :components ((:file "package") 28 | (:file "profiler" :depends-on ("package")) 29 | (:file "overhead" :depends-on ("profiler")))) 30 | --------------------------------------------------------------------------------