Skip to content
Snippets Groups Projects
spell-rt.lisp 3.03 KiB
Newer Older
ram's avatar
ram committed
;;; -*- Log: hemlock.log; Package: Spell -*-
;;;
;;; **********************************************************************
;;; This code was written as part of the CMU Common Lisp project at
;;; Carnegie Mellon University, and has been placed in the public domain.
;;; If you want to use this code or any part of CMU Common Lisp, please contact
;;; Scott Fahlman or slisp-group@cs.cmu.edu.
;;;
(ext:file-comment
  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/spell-rt.lisp,v 1.1.1.4 1992/02/14 23:51:14 wlott Exp $")
ram's avatar
ram committed
;;; **********************************************************************
;;;
;;;    Written by Bill Chiles
;;;
;;; This file contains system dependent primitives for the spelling checking/
;;; correcting code in Spell-Correct.Lisp, Spell-Augment.Lisp, and
;;; Spell-Build.Lisp.

(in-package "SPELL" :use '("LISP" "EXTENSIONS" "SYSTEM"))


;;;; System Area Referencing and Setting

(eval-when (compile eval)

;;; MAKE-SAP returns pointers that *dictionary*, *descriptors*, and
;;; *string-table* are bound to.  Address is in the system area.
;;;
(defmacro make-sap (address)
  `(system:int-sap ,address))
ram's avatar
ram committed

(defmacro system-address (sap)
ram's avatar
ram committed


(defmacro allocate-bytes (count)
  `(system:allocate-system-memory ,count))
ram's avatar
ram committed

(defmacro deallocate-bytes (address byte-count)
  `(system:deallocate-system-memory (int-sap ,address) ,byte-count))
ram's avatar
ram committed


(defmacro sapref (sap offset)
  `(system:sap-ref-16 ,sap ,offset))
ram's avatar
ram committed

(defsetf sapref (sap offset) (value)
  `(setf (system:sap-ref-16 ,sap ,offset) ,value))
ram's avatar
ram committed


(defmacro sap-replace (dst-string src-string src-start dst-start dst-end)
  `(%primitive byte-blt ,src-string ,src-start ,dst-string ,dst-start ,dst-end))

(defmacro string-sapref (sap index)
  `(system:sap-ref-8 ,sap ,index))
ram's avatar
ram committed



;;;; Primitive String Hashing

;;; STRING-HASH employs the instruction SXHASH-SIMPLE-SUBSTRING which takes
;;; an end argument, so we do not have to use SXHASH.  SXHASH would mean
;;; doing a SUBSEQ of entry.
;;;
(defmacro string-hash (string length)
  `(ext:truly-the lisp::index
		  (%primitive sxhash-simple-substring
			      ,string
			      (the fixnum ,length))))
ram's avatar
ram committed

) ;eval-when



;;;; Binary Dictionary File I/O

(defun open-dictionary (f)
  (let* ((filename (ext:unix-namestring f))
	 (kind (unix:unix-file-kind filename)))
    (unless kind (error "Cannot find dictionary -- ~S." filename))
ram's avatar
ram committed
    (multiple-value-bind (fd err)
			 (unix:unix-open filename unix:o_rdonly 0)
ram's avatar
ram committed
      (unless fd
	(error "Opening ~S failed: ~A." filename err))
      (multiple-value-bind (winp dev-or-err) (unix:unix-fstat fd)
ram's avatar
ram committed
	(unless winp (error "Opening ~S failed: ~A." filename dev-or-err))
	fd))))

(defun close-dictionary (fd)
  (unix:unix-close fd))
ram's avatar
ram committed

(defun read-dictionary-structure (fd bytes)
  (let* ((structure (allocate-bytes bytes)))
    (multiple-value-bind (read-bytes err)
			 (unix:unix-read fd structure bytes)
ram's avatar
ram committed
      (when (or (null read-bytes) (not (= bytes read-bytes)))
	(deallocate-bytes (system-address structure) bytes)
	(error "Reading dictionary structure failed: ~A." err))
      structure)))