| ... |
... |
@@ -1254,17 +1254,19 @@ |
|
1254
|
1254
|
|
|
1255
|
1255
|
;;;; Arithmetic
|
|
1256
|
1256
|
|
|
|
1257
|
+(defun sign-extend (x n)
|
|
|
1258
|
+ "Sign extend the N-bit number X"
|
|
|
1259
|
+ (if (logbitp (1- n) x)
|
|
|
1260
|
+ (logior (ash -1 (1- n)) x)
|
|
|
1261
|
+ x))
|
|
|
1262
|
+
|
|
1257
|
1263
|
(defun emit-random-arith-inst (name segment dst src opcode
|
|
1258
|
1264
|
&optional allow-constants)
|
|
1259
|
1265
|
(let ((size (matching-operand-size dst src)))
|
|
1260
|
1266
|
(maybe-emit-operand-size-prefix segment size)
|
|
1261
|
1267
|
(cond
|
|
1262
|
1268
|
((integerp src)
|
|
1263
|
|
- (cond ((and (not (eq size :byte)) (<= -128 src 127))
|
|
1264
|
|
- (emit-byte segment #b10000011)
|
|
1265
|
|
- (emit-ea segment dst opcode allow-constants)
|
|
1266
|
|
- (emit-byte segment src))
|
|
1267
|
|
- ((accumulator-p dst)
|
|
|
1269
|
+ (cond ((accumulator-p dst)
|
|
1268
|
1270
|
(emit-byte segment
|
|
1269
|
1271
|
(dpb opcode
|
|
1270
|
1272
|
(byte 3 3)
|
| ... |
... |
@@ -1272,6 +1274,10 @@ |
|
1272
|
1274
|
#b00000100
|
|
1273
|
1275
|
#b00000101)))
|
|
1274
|
1276
|
(emit-sized-immediate segment size src))
|
|
|
1277
|
+ ((and (not (eq size :byte)) (<= -128 (sign-extend src 32) 127))
|
|
|
1278
|
+ (emit-byte segment #b10000011)
|
|
|
1279
|
+ (emit-ea segment dst opcode allow-constants)
|
|
|
1280
|
+ (emit-byte segment (ldb (byte 8 0) src)))
|
|
1275
|
1281
|
(t
|
|
1276
|
1282
|
(emit-byte segment (if (eq size :byte) #b10000000 #b10000001))
|
|
1277
|
1283
|
(emit-ea segment dst opcode allow-constants)
|
| ... |
... |
@@ -1291,12 +1297,24 @@ |
|
1291
|
1297
|
(t
|
|
1292
|
1298
|
(error "Bogus operands to ~A" name)))))
|
|
1293
|
1299
|
|
|
|
1300
|
+(defun arith-logical-constant-control (chunk inst stream dstate)
|
|
|
1301
|
+ (declare (ignore inst stream))
|
|
|
1302
|
+ (when (= (ldb (byte 8 0) chunk) #b10000011)
|
|
|
1303
|
+ (let ((imm (sign-extend (ldb (byte 8 16) chunk) 8)))
|
|
|
1304
|
+ (when (minusp imm)
|
|
|
1305
|
+ (disassem:note #'(lambda (stream)
|
|
|
1306
|
+ (princ (ldb (byte 32 0) imm) stream))
|
|
|
1307
|
+ dstate)))))
|
|
|
1308
|
+
|
|
1294
|
1309
|
(eval-when (compile eval)
|
|
1295
|
|
- (defun arith-inst-printer-list (subop)
|
|
1296
|
|
- `((accum-imm ((op ,(dpb subop (byte 3 2) #b0000010))))
|
|
1297
|
|
- (reg/mem-imm ((op (#b1000000 ,subop))))
|
|
|
1310
|
+ (defun arith-inst-printer-list (subop &key control)
|
|
|
1311
|
+ `((accum-imm ((op ,(dpb subop (byte 3 2) #b0000010)))
|
|
|
1312
|
+ ,@(when control `(:default :control #',control)))
|
|
|
1313
|
+ (reg/mem-imm ((op (#b1000000 ,subop)))
|
|
|
1314
|
+ ,@(when control `(:default :control #',control)))
|
|
1298
|
1315
|
(reg/mem-imm ((op (#b1000001 ,subop))
|
|
1299
|
|
- (imm nil :type signed-imm-byte)))
|
|
|
1316
|
+ (imm nil :type signed-imm-byte))
|
|
|
1317
|
+ ,@(when control `(:default :control #',control)))
|
|
1300
|
1318
|
(reg-reg/mem-dir ((op ,(dpb subop (byte 3 1) #b000000))))))
|
|
1301
|
1319
|
)
|
|
1302
|
1320
|
|
| ... |
... |
@@ -1602,7 +1620,7 @@ |
|
1602
|
1620
|
|
|
1603
|
1621
|
(define-instruction and (segment dst src)
|
|
1604
|
1622
|
(:printer-list
|
|
1605
|
|
- (arith-inst-printer-list #b100))
|
|
|
1623
|
+ (arith-inst-printer-list #b100 :control 'arith-logical-constant-control))
|
|
1606
|
1624
|
(:emitter
|
|
1607
|
1625
|
(emit-random-arith-inst "AND" segment dst src #b100)))
|
|
1608
|
1626
|
|
| ... |
... |
@@ -1639,13 +1657,13 @@ |
|
1639
|
1657
|
|
|
1640
|
1658
|
(define-instruction or (segment dst src)
|
|
1641
|
1659
|
(:printer-list
|
|
1642
|
|
- (arith-inst-printer-list #b001))
|
|
|
1660
|
+ (arith-inst-printer-list #b001 :control 'arith-logical-constant-control))
|
|
1643
|
1661
|
(:emitter
|
|
1644
|
1662
|
(emit-random-arith-inst "OR" segment dst src #b001)))
|
|
1645
|
1663
|
|
|
1646
|
1664
|
(define-instruction xor (segment dst src)
|
|
1647
|
1665
|
(:printer-list
|
|
1648
|
|
- (arith-inst-printer-list #b110))
|
|
|
1666
|
+ (arith-inst-printer-list #b110 :control 'arith-logical-constant-control))
|
|
1649
|
1667
|
(:emitter
|
|
1650
|
1668
|
(emit-random-arith-inst "XOR" segment dst src #b110)))
|
|
1651
|
1669
|
|