/[cmucl]/src/hemlock/spell-rt.lisp
ViewVC logotype

Contents of /src/hemlock/spell-rt.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.3 - (show annotations)
Mon Oct 31 04:50:12 1994 UTC (19 years, 5 months ago) by ram
Branch: MAIN
CVS Tags: sparc-tramp-assem-base, double-double-array-base, post-merge-intl-branch, release-19b-pre1, release-19b-pre2, merged-unicode-utf16-extfmt-2009-06-11, double-double-init-sparc-2, unicode-utf16-extfmt-2009-03-27, double-double-base, snapshot-2007-09, snapshot-2007-08, snapshot-2008-08, snapshot-2008-09, ppc_gencgc_snap_2006-01-06, sse2-packed-2008-11-12, snapshot-2008-05, snapshot-2008-06, snapshot-2008-07, snapshot-2007-05, snapshot-2008-01, snapshot-2008-02, snapshot-2008-03, intl-branch-working-2010-02-19-1000, snapshot-2006-11, snapshot-2006-10, double-double-init-sparc, snapshot-2006-12, unicode-string-buffer-impl-base, sse2-base, release-20b-pre1, release-20b-pre2, unicode-string-buffer-base, RELEASE_18d, sse2-packed-base, sparc-tramp-assem-2010-07-19, amd64-dd-start, snapshot-2003-10, snapshot-2004-10, release-18e-base, release-19f-pre1, snapshot-2008-12, snapshot-2008-11, intl-2-branch-base, snapshot-2004-08, snapshot-2004-09, remove_negative_zero_not_zero, snapshot-2007-01, snapshot-2007-02, snapshot-2004-05, snapshot-2004-06, snapshot-2004-07, release-19e, release-19d, GIT-CONVERSION, double-double-init-ppc, release-19c, dynamic-extent-base, unicode-utf16-sync-2008-12, LINKAGE_TABLE, release-19c-base, cross-sol-x86-merged, label-2009-03-16, release-19f-base, PRE_LINKAGE_TABLE, merge-sse2-packed, mod-arith-base, sparc_gencgc_merge, merge-with-19f, snapshot-2004-12, snapshot-2004-11, intl-branch-working-2010-02-11-1000, RELEASE_18a, RELEASE_18b, RELEASE_18c, unicode-snapshot-2009-05, unicode-snapshot-2009-06, amd64-merge-start, ppc_gencgc_snap_2005-12-17, double-double-init-%make-sparc, unicode-utf16-sync-2008-07, release-18e-pre2, unicode-utf16-sync-2008-09, unicode-utf16-extfmts-sync-2008-12, prm-before-macosx-merge-tag, cold-pcl-base, RELEASE_20b, snapshot-2008-04, snapshot-2003-11, snapshot-2005-07, unicode-utf16-sync-label-2009-03-16, RELEASE_19f, snapshot-2007-03, release-20a-base, cross-sol-x86-base, unicode-utf16-char-support-2009-03-26, unicode-utf16-char-support-2009-03-25, release-19a-base, unicode-utf16-extfmts-pre-sync-2008-11, snapshot-2008-10, sparc_gencgc, snapshot-2007-04, snapshot-2010-12, snapshot-2010-11, unicode-utf16-sync-2008-11, snapshot-2007-07, snapshot-2011-09, snapshot-2011-06, snapshot-2011-07, snapshot-2011-04, snapshot-2007-06, snapshot-2011-02, snapshot-2011-03, snapshot-2011-01, snapshot-2003-12, release-19a-pre1, release-19a-pre3, release-19a-pre2, pre-merge-intl-branch, release-19a, UNICODE-BASE, double-double-array-checkpoint, double-double-reader-checkpoint-1, release-19d-base, release-19e-pre1, double-double-irrat-end, release-19e-pre2, snapshot-2010-05, snapshot-2010-04, snapshot-2010-07, snapshot-2010-06, snapshot-2010-01, snapshot-2010-03, snapshot-2010-02, release-19d-pre2, release-19d-pre1, snapshot-2010-08, release-18e, double-double-init-checkpoint-1, double-double-reader-base, label-2009-03-25, snapshot-2005-03, release-19b-base, cross-sol-x86-2010-12-20, double-double-init-x86, sse2-checkpoint-2008-10-01, intl-branch-2010-03-18-1300, snapshot-2005-11, double-double-sparc-checkpoint-1, snapshot-2004-04, sse2-merge-with-2008-11, sse2-merge-with-2008-10, snapshot-2005-10, RELEASE_20a, snapshot-2005-12, release-20a-pre1, snapshot-2005-01, snapshot-2009-11, snapshot-2009-12, unicode-utf16-extfmt-2009-06-11, portable-clx-import-2009-06-16, unicode-utf16-string-support, release-19c-pre1, cross-sparc-branch-base, release-19e-base, intl-branch-base, double-double-irrat-start, snapshot-2005-06, snapshot-2005-05, snapshot-2005-04, ppc_gencgc_snap_2005-05-14, snapshot-2005-02, unicode-utf16-base, portable-clx-base, snapshot-2005-09, snapshot-2005-08, lisp-executable-base, snapshot-2009-08, snapshot-2007-12, snapshot-2007-10, snapshot-2007-11, snapshot-2009-02, snapshot-2009-01, snapshot-2009-07, snapshot-2009-05, snapshot-2009-04, snapshot-2006-02, snapshot-2006-03, release-18e-pre1, snapshot-2006-01, snapshot-2006-06, snapshot-2006-07, snapshot-2006-04, snapshot-2006-05, pre-telent-clx, snapshot-2006-08, snapshot-2006-09, HEAD
Branch point for: release-19b-branch, double-double-reader-branch, double-double-array-branch, mod-arith-branch, RELEASE-19F-BRANCH, portable-clx-branch, sparc_gencgc_branch, cross-sparc-branch, RELEASE-20B-BRANCH, RELENG_18, unicode-string-buffer-branch, sparc-tramp-assem-branch, dynamic-extent, UNICODE-BRANCH, release-19d-branch, ppc_gencgc_branch, sse2-packed-branch, lisp-executable, RELEASE-20A-BRANCH, amd64-dd-branch, double-double-branch, unicode-string-buffer-impl-branch, intl-branch, release-18e-branch, cold-pcl, unicode-utf16-branch, cross-sol-x86-branch, release-19e-branch, sse2-branch, release-19a-branch, release-19c-branch, intl-2-branch, unicode-utf16-extfmt-branch
Changes since 1.2: +1 -3 lines
Fix headed boilerplate.
1 ;;; -*- Log: hemlock.log; Package: Spell -*-
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 (ext:file-comment
8 "$Header: /tiger/var/lib/cvsroots/cmucl/src/hemlock/spell-rt.lisp,v 1.3 1994/10/31 04:50:12 ram Rel $")
9 ;;;
10 ;;; **********************************************************************
11 ;;;
12 ;;; Written by Bill Chiles
13 ;;;
14 ;;; This file contains system dependent primitives for the spelling checking/
15 ;;; correcting code in Spell-Correct.Lisp, Spell-Augment.Lisp, and
16 ;;; Spell-Build.Lisp.
17
18 (defpackage "SPELL"
19 (:use "LISP" "EXTENSIONS" "SYSTEM")
20 (:export spell-try-word spell-root-word spell-collect-close-words
21 maybe-read-spell-dictionary correct-spelling max-entry-length
22 spell-read-dictionary spell-add-entry spell-root-flags
23 spell-remove-entry))
24
25 (in-package "SPELL")
26
27
28 ;;;; System Area Referencing and Setting
29
30 (eval-when (compile eval)
31
32 ;;; MAKE-SAP returns pointers that *dictionary*, *descriptors*, and
33 ;;; *string-table* are bound to. Address is in the system area.
34 ;;;
35 (defmacro make-sap (address)
36 `(system:int-sap ,address))
37
38 (defmacro system-address (sap)
39 `(system:sap-int ,sap))
40
41
42 (defmacro allocate-bytes (count)
43 `(system:allocate-system-memory ,count))
44
45 (defmacro deallocate-bytes (address byte-count)
46 `(system:deallocate-system-memory (int-sap ,address) ,byte-count))
47
48
49 (defmacro sapref (sap offset)
50 `(system:sap-ref-16 ,sap (* ,offset 2)))
51
52 (defsetf sapref (sap offset) (value)
53 `(setf (system:sap-ref-16 ,sap (* ,offset 2)) ,value))
54
55
56 (defmacro sap-replace (dst-string src-string src-start dst-start dst-end)
57 `(%primitive byte-blt ,src-string ,src-start ,dst-string ,dst-start ,dst-end))
58
59 (defmacro string-sapref (sap index)
60 `(system:sap-ref-8 ,sap ,index))
61
62
63
64 ;;;; Primitive String Hashing
65
66 ;;; STRING-HASH employs the instruction SXHASH-SIMPLE-SUBSTRING which takes
67 ;;; an end argument, so we do not have to use SXHASH. SXHASH would mean
68 ;;; doing a SUBSEQ of entry.
69 ;;;
70 (defmacro string-hash (string length)
71 `(ext:truly-the lisp::index
72 (%primitive sxhash-simple-substring
73 ,string
74 (the fixnum ,length))))
75
76 ) ;eval-when
77
78
79
80 ;;;; Binary Dictionary File I/O
81
82 (defun open-dictionary (f)
83 (let* ((filename (ext:unix-namestring f))
84 (kind (unix:unix-file-kind filename)))
85 (unless kind (error "Cannot find dictionary -- ~S." filename))
86 (multiple-value-bind (fd err)
87 (unix:unix-open filename unix:o_rdonly 0)
88 (unless fd
89 (error "Opening ~S failed: ~A." filename err))
90 (multiple-value-bind (winp dev-or-err) (unix:unix-fstat fd)
91 (unless winp (error "Opening ~S failed: ~A." filename dev-or-err))
92 fd))))
93
94 (defun close-dictionary (fd)
95 (unix:unix-close fd))
96
97 (defun read-dictionary-structure (fd bytes)
98 (let* ((structure (allocate-bytes bytes)))
99 (multiple-value-bind (read-bytes err)
100 (unix:unix-read fd structure bytes)
101 (when (or (null read-bytes) (not (= bytes read-bytes)))
102 (deallocate-bytes (system-address structure) bytes)
103 (error "Reading dictionary structure failed: ~A." err))
104 structure)))

  ViewVC Help
Powered by ViewVC 1.1.5