aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman1994-05-01 20:25:06 +0000
committerRichard M. Stallman1994-05-01 20:25:06 +0000
commit21f2acd3f9f1d2616e4b39704718a7728d7db2ea (patch)
tree750ef5dcd2c08ef573e2725b143ac6e4624f2b48
parentec4dfb6bfbc8bd9e9adc32bac2a4cb598a99b827 (diff)
downloademacs-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.el42
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)