/[cmucl]/src/hemlock/hacks.lisp
ViewVC logotype

Contents of /src/hemlock/hacks.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (hide annotations)
Mon Jun 29 21:10:49 2009 UTC (4 years, 9 months ago) by rtoy
Branch: MAIN
CVS Tags: sparc-tramp-assem-base, post-merge-intl-branch, intl-branch-working-2010-02-19-1000, unicode-string-buffer-impl-base, release-20b-pre1, release-20b-pre2, unicode-string-buffer-base, sparc-tramp-assem-2010-07-19, amd64-dd-start, intl-2-branch-base, GIT-CONVERSION, cross-sol-x86-merged, intl-branch-working-2010-02-11-1000, RELEASE_20b, release-20a-base, cross-sol-x86-base, snapshot-2010-12, snapshot-2010-11, snapshot-2011-09, snapshot-2011-06, snapshot-2011-07, snapshot-2011-04, snapshot-2011-02, snapshot-2011-03, snapshot-2011-01, pre-merge-intl-branch, snapshot-2010-05, snapshot-2010-04, snapshot-2010-07, snapshot-2010-06, snapshot-2010-01, snapshot-2010-03, snapshot-2010-02, snapshot-2010-08, cross-sol-x86-2010-12-20, intl-branch-2010-03-18-1300, RELEASE_20a, release-20a-pre1, snapshot-2009-11, snapshot-2009-12, cross-sparc-branch-base, intl-branch-base, snapshot-2009-08, snapshot-2009-07, HEAD
Branch point for: cross-sparc-branch, RELEASE-20B-BRANCH, unicode-string-buffer-branch, sparc-tramp-assem-branch, RELEASE-20A-BRANCH, amd64-dd-branch, unicode-string-buffer-impl-branch, intl-branch, cross-sol-x86-branch, intl-2-branch
Changes since 1.4: +26 -4 lines
Make reading and writing from files work with unicode.  (Of course,
only 8-bit characters are supported.)

hacks.lisp:
o Update %SP-BYTE-BLT to be able to handle saps and strings for either
  the source or destination.

files.lisp:
o Use %SP-BYTE-BLT instead of %PRIMITIVE BYTE-BLT.
1 ram 1.1 (in-package "HI")
2    
3     (defun %sp-byte-blt (src start dest dstart end)
4 rtoy 1.4 #-unicode
5     (%primitive byte-blt src start dest dstart end)
6     #+unicode
7 rtoy 1.5 (etypecase src
8     (system:system-area-pointer
9     (etypecase dest
10     (system:system-area-pointer
11     (loop for di of-type fixnum from dstart below end
12     for si of-type fixnum from start
13     do
14     (setf (sys:sap-ref-8 dest di) (sys:sap-ref-8 src si))))
15     (string
16     (loop for di of-type fixnum from dstart below end
17     for si of-type fixnum from start
18     do
19     (setf (aref dest di) (code-char (sys:sap-ref-8 src si)))))))
20     (string
21     (etypecase dest
22     (system:system-area-pointer
23     (loop for di of-type fixnum from dstart below end
24     for si of-type fixnum from start
25     do
26     (setf (sys:sap-ref-8 dest di) (logand #xff (char-code (aref src si))))))
27     (string
28     (loop for di of-type fixnum from dstart below end
29     for si of-type fixnum from start
30     do
31     (setf (aref dest di) (aref src si))))))))
32    
33 ram 1.1
34     (defun lisp::sap-to-fixnum (x) (sap-int x))
35     (defun lisp::fixnum-to-sap (x) (int-sap x))
36     (defun lisp::%sp-make-fixnum (x) (%primitive make-fixnum x))
37     (defun lisp::fast-char-upcase (x) (char-upcase x))
38    
39     ;;; prepare-window-for-redisplay -- Internal
40     ;;;
41     ;;; Called by make-window to do whatever redisplay wants to set up
42     ;;; a new window.
43     ;;;
44     (defun prepare-window-for-redisplay (window)
45     (setf (window-old-lines window) 0))
46    
47     (defparameter hunk-width-limit 256)
48    
49     (defun reverse-video-hook-fun (&rest foo)
50     (declare (ignore foo)))

  ViewVC Help
Powered by ViewVC 1.1.5