diff options
| author | Richard M. Stallman | 1994-05-01 20:25:06 +0000 |
|---|---|---|
| committer | Richard M. Stallman | 1994-05-01 20:25:06 +0000 |
| commit | 21f2acd3f9f1d2616e4b39704718a7728d7db2ea (patch) | |
| tree | 750ef5dcd2c08ef573e2725b143ac6e4624f2b48 | |
| parent | ec4dfb6bfbc8bd9e9adc32bac2a4cb598a99b827 (diff) | |
| download | emacs-21f2acd3f9f1d2616e4b39704718a7728d7db2ea.tar.gz emacs-21f2acd3f9f1d2616e4b39704718a7728d7db2ea.zip | |
(set-register-value): Setting the high byte of a
register trashed the low byte.
(set-register-value): Fixed test so the value 0 can be set.
(set-register-value): Rewrote to use bit operations instead of
multiplication and division.
(register-name-by-word-alist, register-name-by-byte-alist):
Combined into one list, register-name-alist.
(register-value, set-register-value): Use combined list.
(mode-line-format): Make the %n pure.
| -rw-r--r-- | lisp/dos-fns.el | 42 |
1 files changed, 18 insertions, 24 deletions
diff --git a/lisp/dos-fns.el b/lisp/dos-fns.el index 0ef0e44b9fa..a403ccd76e0 100644 --- a/lisp/dos-fns.el +++ b/lisp/dos-fns.el | |||
| @@ -35,7 +35,8 @@ | |||
| 35 | 'global-mode-string | 35 | 'global-mode-string |
| 36 | (purecopy " %[(") | 36 | (purecopy " %[(") |
| 37 | (purecopy "%t:") | 37 | (purecopy "%t:") |
| 38 | 'mode-name 'mode-line-process 'minor-mode-alist "%n" | 38 | 'mode-name 'mode-line-process 'minor-mode-alist |
| 39 | (purecopy "%n") | ||
| 39 | (purecopy ")%]--") | 40 | (purecopy ")%]--") |
| 40 | (purecopy '(line-number-mode "L%l--")) | 41 | (purecopy '(line-number-mode "L%l--")) |
| 41 | (purecopy '(-3 . "%p")) | 42 | (purecopy '(-3 . "%p")) |
| @@ -53,7 +54,7 @@ | |||
| 53 | ; Unix stuff | 54 | ; Unix stuff |
| 54 | ("\\.tp[ulpw]$" . t) | 55 | ("\\.tp[ulpw]$" . t) |
| 55 | ; Borland Pascal stuff | 56 | ; Borland Pascal stuff |
| 56 | ("[:/]tags$" . t ) | 57 | ("[:/]tags$" . t) |
| 57 | ; Emacs TAGS file | 58 | ; Emacs TAGS file |
| 58 | ) | 59 | ) |
| 59 | "*Alist for distinguishing text files from binary files. | 60 | "*Alist for distinguishing text files from binary files. |
| @@ -104,22 +105,17 @@ against the file name, and TYPE is nil for text, t for binary.") | |||
| 104 | (defvar msdos-shells '("command.com" "4dos.com" "ndos.com") | 105 | (defvar msdos-shells '("command.com" "4dos.com" "ndos.com") |
| 105 | "*List of shells that use `/c' instead of `-c' and a backslashed command.") | 106 | "*List of shells that use `/c' instead of `-c' and a backslashed command.") |
| 106 | 107 | ||
| 107 | (defconst register-name-by-word-alist | 108 | (defconst register-name-alist |
| 108 | '((ax . 0) (bx . 1) (cx . 2) (dx . 3) (si . 4) (di . 5) | 109 | '((ax . 0) (bx . 1) (cx . 2) (dx . 3) (si . 4) (di . 5) |
| 109 | (cflag . 6) (flags . 7))) | 110 | (cflag . 6) (flags . 7) |
| 110 | 111 | (al . (0 . 0)) (bl . (1 . 0)) (cl . (2 . 0)) (dl . (3 . 0)) | |
| 111 | (defconst register-name-by-byte-alist | 112 | (ah . (0 . 1)) (bh . (1 . 1)) (ch . (2 . 1)) (dh . (3 . 1)))) |
| 112 | '((al . (0 . 0)) (ah . (0 . 1)) | ||
| 113 | (bl . (1 . 0)) (bh . (1 . 1)) | ||
| 114 | (cl . (2 . 0)) (ch . (2 . 1)) | ||
| 115 | (dl . (3 . 0)) (dh . (3 . 1)))) | ||
| 116 | 113 | ||
| 117 | (defun make-register () | 114 | (defun make-register () |
| 118 | (make-vector 8 0)) | 115 | (make-vector 8 0)) |
| 119 | 116 | ||
| 120 | (defun register-value (regs name) | 117 | (defun register-value (regs name) |
| 121 | (let ((where (or (cdr (assoc name register-name-by-word-alist)) | 118 | (let ((where (cdr (assoc name register-name-alist)))) |
| 122 | (cdr (assoc name register-name-by-byte-alist))))) | ||
| 123 | (cond ((consp where) | 119 | (cond ((consp where) |
| 124 | (let ((tem (aref regs (car where)))) | 120 | (let ((tem (aref regs (car where)))) |
| 125 | (if (zerop (cdr where)) | 121 | (if (zerop (cdr where)) |
| @@ -131,20 +127,18 @@ against the file name, and TYPE is nil for text, t for binary.") | |||
| 131 | 127 | ||
| 132 | (defun set-register-value (regs name value) | 128 | (defun set-register-value (regs name value) |
| 133 | (and (numberp value) | 129 | (and (numberp value) |
| 134 | (> value 0) | 130 | (>= value 0) |
| 135 | (let ((where (or (cdr (assoc name register-name-by-word-alist)) | 131 | (let ((where (cdr (assoc name register-name-alist)))) |
| 136 | (cdr (assoc name register-name-by-byte-alist))))) | ||
| 137 | (cond ((consp where) | 132 | (cond ((consp where) |
| 138 | (setq value (% value 256)) ; 0x100 | 133 | (let ((tem (aref regs (car where))) |
| 139 | (let* ((tem (aref regs (car where))) | 134 | (value (logand value 255))) |
| 140 | (l (% tem 256)) | 135 | (aset regs |
| 141 | (h (/ tem 256))) | 136 | (car where) |
| 142 | (if (zerop (cdr where)) | 137 | (if (zerop (cdr where)) |
| 143 | (aset regs (car where) (+ (* h 256) value)) | 138 | (logior (logand tem 65280) value) |
| 144 | (aset regs (car where) (+ (* value 256) h))))) | 139 | (logior (logand tem 255) (lsh value 8)))))) |
| 145 | ((numberp where) | 140 | ((numberp where) |
| 146 | (setq value (% value 65536)) ; 0x10000 | 141 | (aset regs where (logand value 65535)))))) |
| 147 | (aset regs where value))))) | ||
| 148 | regs) | 142 | regs) |
| 149 | 143 | ||
| 150 | (defsubst intdos (regs) | 144 | (defsubst intdos (regs) |