1#| -*-Scheme-*-
2
3Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
4    1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
5    2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013, 2014 Massachusetts
6    Institute of Technology
7
8This file is part of MIT/GNU Scheme.
9
10MIT/GNU Scheme is free software; you can redistribute it and/or modify
11it under the terms of the GNU General Public License as published by
12the Free Software Foundation; either version 2 of the License, or (at
13your option) any later version.
14
15MIT/GNU Scheme is distributed in the hope that it will be useful, but
16WITHOUT ANY WARRANTY; without even the implied warranty of
17MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
18General Public License for more details.
19
20You should have received a copy of the GNU General Public License
21along with MIT/GNU Scheme; if not, write to the Free Software
22Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
23USA.
24
25|#
26
27;;;; VAX Instruction Set Description, Part 3
28
29;;; The ordering is essentially that in "Vax Architecture Handbook" 1981.
30
31(declare (usual-integrations))
32
33(define-instruction ASH
34  ((L (? cnt ea-r-b) (? src ea-r-l) (? dst ea-w-l))
35   (BYTE (8 #x78))
36   (OPERAND B  cnt)
37   (OPERAND L src)
38   (OPERAND L dst))
39
40  ((Q (? cnt ea-r-b) (? src ea-r-q) (? dst ea-w-q))
41   (BYTE (8 #x79))
42   (OPERAND B cnt)
43   (OPERAND Q src)
44   (OPERAND Q dst)))
45
46(define-instruction ROTL
47  (((? cnt ea-r-b) (? src ea-r-l) (? dst ea-w-l))
48   (BYTE (8 #x9C))
49   (OPERAND B cnt)
50   (OPERAND L src)
51   (OPERAND L dst)))
52
53(define-instruction POLY
54  ((F (? arg ea-r-f) (? degree ea-r-w) (? tbladdr ea-a-b))
55   (BYTE (8 #x55))
56   (OPERAND F arg)
57   (OPERAND W degree)
58   (OPERAND B tbladdr))
59
60  ((D (? arg ea-r-d) (? degree ea-r-w) (? tbladdr ea-a-b))
61   (BYTE (8 #x75))
62   (OPERAND D arg)
63   (OPERAND W degree)
64   (OPERAND B tbladdr))
65
66  ((G (? arg ea-r-g) (? degree ea-r-w) (? tbladdr ea-a-b))
67   (BYTE (16 #x55FD))
68   (OPERAND G arg)
69   (OPERAND W degree)
70   (OPERAND B tbladdr))
71
72  ((H (? arg ea-r-h) (? degree ea-r-w) (? tbladdr ea-a-b))
73   (BYTE (16 #x75FD))
74   (OPERAND H arg)
75   (OPERAND W degree)
76   (OPERAND B tbladdr)))
77
78;;;; Special instructions (Chap. 12)
79
80(define-instruction PUSHR
81  (((? mask ea-r-w))
82   (BYTE (8 #xBB))
83   (OPERAND W mask)))
84
85(define-instruction POPR
86  (((? mask ea-r-w))
87   (BYTE (8 #xBA))
88   (OPERAND W mask)))
89
90(define-instruction MOVPSL
91  (((? dst ea-w-l))
92   (BYTE (8 #xDC))
93   (OPERAND L dst)))
94
95(define-instruction BISPSW
96  (((? mask ea-r-w))
97   (BYTE (8 #xB8))
98   (OPERAND W mask)))
99
100(define-instruction BICPSW
101  (((? mask ea-r-w))
102   (BYTE (8 #xB9))
103   (OPERAND W mask)))
104
105(define-instruction MOVA
106  ((B (? src ea-a-b) (? dst ea-w-l))
107   (BYTE (8 #x9E))
108   (OPERAND B src)
109   (OPERAND L dst))
110
111  ((W (? src ea-a-w) (? dst ea-w-l))
112   (BYTE (8 #x3E))
113   (OPERAND W src)
114   (OPERAND L dst))
115
116  ((L (? src ea-a-l) (? dst ea-w-l))
117   (BYTE (8 #xDE))
118   (OPERAND L src)
119   (OPERAND L dst))
120
121  ((F (? src ea-a-f) (? dst ea-w-l))
122   (BYTE (8 #xDE))
123   (OPERAND F src)
124   (OPERAND L dst))
125
126  ((Q (? src ea-a-q) (? dst ea-w-l))
127   (BYTE (8 #x7E))
128   (OPERAND Q src)
129   (OPERAND L dst))
130
131  ((D (? src ea-a-d) (? dst ea-w-l))
132   (BYTE (8 #x7E))
133   (OPERAND D src)
134   (OPERAND L dst))
135
136  ((G (? src ea-a-g) (? dst ea-w-l))
137   (BYTE (8 #x7E))
138   (OPERAND G src)
139   (OPERAND L dst))
140
141  ((H (? src ea-a-h) (? dst ea-w-l))
142   (BYTE (16 #x7EFD))
143   (OPERAND H src)
144   (OPERAND L dst))
145
146  ((O (? src ea-a-o) (? dst ea-w-l))
147   (BYTE (16 #x7EFD))
148   (OPERAND O src)
149   (OPERAND L dst)))
150
151(define-instruction PUSHA
152  ((B (? src ea-a-b))
153   (BYTE (8 #x9F))
154   (OPERAND B src))
155
156  ((W (? src ea-a-w))
157   (BYTE (8 #x3F))
158   (OPERAND W src))
159
160  ((L (? src ea-a-l))
161   (BYTE (8 #xDF))
162   (OPERAND L src))
163
164  ((F (? src ea-a-f))
165   (BYTE (8 #xDF))
166   (OPERAND F src))
167
168  ((Q (? src ea-a-q))
169   (BYTE (8 #x7F))
170   (OPERAND Q src))
171
172  ((D (? src ea-a-d))
173   (BYTE (8 #x7F))
174   (OPERAND D src))
175
176  ((G (? src ea-a-g))
177   (BYTE (8 #x7F))
178   (OPERAND G src))
179
180  ((H (? src ea-a-h))
181   (BYTE (16 #x7FFD))
182   (OPERAND H src))
183
184  ((O (? src ea-a-o))
185   (BYTE (16 #x7FFD))
186   (OPERAND O src)))
187
188;;; Array indeces and queues
189
190(define-instruction INDEX
191  (((? subscript ea-r-l) (? low ea-r-l) (? high ea-r-l)
192    (? size ea-r-l) (? indexin ea-r-l) (? indexout ea-w-l))
193   (BYTE (8 #x0A))
194   (OPERAND L subscript)
195   (OPERAND L low)
196   (OPERAND L high)
197   (OPERAND L size)
198   (OPERAND L indexin)
199   (OPERAND L indexout)))
200
201(define-instruction INSQUE
202  (((? entry ea-a-b) (? pred ea-a-b))
203   (BYTE (8 #x0E))
204   (OPERAND B entry)
205   (OPERAND B pred)))
206
207(define-instruction REMQUE
208  (((? entry ea-a-b) (? addr ea-w-l))
209   (BYTE (8 #x0F))
210   (OPERAND B entry)
211   (OPERAND L addr)))
212
213(define-instruction INSQHI
214  (((? entry ea-a-b) (? header ea-a-q))
215   (BYTE (8 #x5C))
216   (OPERAND B entry)
217   (OPERAND Q header)))
218
219(define-instruction INSQTI
220  (((? entry ea-a-b) (? header ea-a-q))
221   (BYTE (8 #x5D))
222   (OPERAND B entry)
223   (OPERAND Q header)))
224
225(define-instruction REMQHI
226  (((? header ea-a-q) (? addr ea-w-l))
227   (BYTE (8 #x5E))
228   (OPERAND Q header)
229   (OPERAND L addr)))
230
231(define-instruction REMQTI
232  (((? header ea-a-q) (? addr ea-w-l))
233   (BYTE (8 #x5F))
234   (OPERAND Q header)
235   (OPERAND L addr)))
236
237;;; Bit field instructions
238
239(let-syntax
240    ((define-field-instruction
241       (sc-macro-transformer
242	(lambda (form environment)
243	  environment
244	  (let ((name (list-ref form 1))
245		(suffix1 (list-ref form 2))
246		(suffix2 (list-ref form 3))
247		(opcode (list-ref form 4))
248		(mode (list-ref form 5)))
249	    `(DEFINE-INSTRUCTION ,name
250	       ((,suffix1 (? pos ea-r-l) (? size ea-r-b) (? base ea-v-b)
251			  (? dst ,mode))
252		(BYTE (8 ,opcode))
253		(OPERAND L pos)
254		(OPERAND B size)
255		(OPERAND B base)
256		(OPERAND L dst))
257
258	       ((,suffix2 (? pos ea-r-l) (? size ea-r-b) (? base ea-v-b)
259			  (? dst ,mode))
260		(BYTE (8 ,(1+ opcode)))
261		(OPERAND L pos)
262		(OPERAND B size)
263		(OPERAND B base)
264		(OPERAND L dst))))))))
265
266  (define-field-instruction FF S C #xEA ea-w-l)
267  (define-field-instruction EXTV S Z #xEE ea-w-l)
268  (define-field-instruction CMPV S Z #xEC ea-r-l))
269
270(define-instruction INSV
271  (((? src ea-r-l) (? pos ea-r-l) (? size ea-r-b) (? base ea-v-b))
272   (BYTE (8 #xF0))
273   (OPERAND L src)
274   (OPERAND L pos)
275   (OPERAND B size)
276   (OPERAND B base)))
277
278;;;; Control instructions (Chap. 13)
279
280;; The VAX only has byte offset conditional branch instructions.
281;; Longer displacements are obtained by negating the condition and
282;; branching over an unconditional instruction.
283
284(define-instruction B
285  ((B (? c cc) (@PCO (? dest)))
286   (BYTE (4 c) (4 #x1))
287   (DISPLACEMENT (8 dest)))
288
289  ((B (? c cc) (@PCR (? dest)))
290   (BYTE (4 c) (4 #x1))
291   (DISPLACEMENT (8 `(- ,dest (+ *PC* 1)))))
292
293  ((W (? c inverse-cc) (@PCO (? dest)))
294   (BYTE (4 c) (4 #x1))			; (B B (~ cc) (+ *PC* 3))
295   (BYTE (8 #x03 SIGNED))
296   (BYTE (8 #x31))			; (BR W dest)
297   (DISPLACEMENT (16 dest)))
298
299  ((W (? c inverse-cc) (@PCR (? dest)))
300   (BYTE (4 c) (4 #x1))			; (B B (~ cc) (+ *PC* 3))
301   (BYTE (8 #x03 SIGNED))
302   (BYTE (8 #x31))			; (BR W dest)
303   (DISPLACEMENT (16 `(- ,dest (+ *PC* 2)))))
304
305  ;; Self adjusting version. It does not handle @PCO
306  (((? c cc cs) (@PCR (? label)))
307   (VARIABLE-WIDTH
308    (disp `(- ,label (+ *PC* 2)))
309    ((-128 127)
310     (BYTE (4 c) (4 #x1))
311     (BYTE (8 disp SIGNED)))
312    ((-32765 32770)
313     (BYTE (4 (inverse-cc cs)) (4 #x1))	; (B B (~ cc) (+ *PC* 3))
314     (BYTE (8 #x03))
315     (BYTE (8 #x31))			; (BR W label)
316     (BYTE (16 (- disp 3) SIGNED)))
317    ((() ())
318     (BYTE (4 (inverse-cc cs)) (4 #x1))	; (B B (~ cc) (+ *PC* 6))
319     (BYTE (8 #x06))
320     (BYTE (8 #x17))			; (JMP (@PCO L label))
321     (BYTE (4 15) (4 14))
322     (BYTE (32 (- disp 6) SIGNED)))))
323
324  (((? c cc cs) (@PCRO (? label) (? offset))) ; Kludge!
325   (VARIABLE-WIDTH
326    (disp `(+ ,offset (- ,label (+ *PC* 2))))
327    ((-128 127)
328     (BYTE (4 c) (4 #x1))
329     (BYTE (8 disp SIGNED)))
330    ((-32765 32770)
331     (BYTE (4 (inverse-cc cs)) (4 #x1))	; (B B (~ cc) (+ *PC* 3))
332     (BYTE (8 #x03))
333     (BYTE (8 #x31))			; (BR W label)
334     (BYTE (16 (- disp 3) SIGNED)))
335    ((() ())
336     (BYTE (4 (inverse-cc cs)) (4 #x1))	; (B B (~ cc) (+ *PC* 6))
337     (BYTE (8 #x06))
338     (BYTE (8 #x17))			; (JMP (@PCO L label))
339     (BYTE (4 15) (4 14))
340     (BYTE (32 (- disp 6) SIGNED))))))
341
342(let-syntax
343    ((define-unconditional-transfer
344       (sc-macro-transformer
345	(lambda (form environment)
346	  environment
347	  (let ((nameb (cadr form))
348		(namej (caddr form))
349		(bit (cadddr form)))
350	    `(BEGIN
351	       (DEFINE-INSTRUCTION ,nameb
352		 ((B (@PCO (? dest)))
353		  (BYTE (8 ,(+ #x10 bit)))
354		  (DISPLACEMENT (8 dest)))
355
356		 ((B (@PCR (? dest)))
357		  (BYTE (8 ,(+ #x10 bit)))
358		  (DISPLACEMENT (8 `(- ,dest (+ *PC* 1)))))
359
360		 ((W (@PCO (? dest)))
361		  (BYTE (8 ,(+ #x30 bit)))
362		  (DISPLACEMENT (16 dest)))
363
364		 ((W (@PCR (? dest)))
365		  (BYTE (8 ,(+ #x30 bit)))
366		  (DISPLACEMENT (16  `(- ,dest (+ *PC* 2)))))
367
368		 ;; Self tensioned version. @PCO not handled.
369		 (((@PCR (? label)))
370		  (VARIABLE-WIDTH
371		   (disp `(- ,label (+ *PC* 2)))
372		   ((-128 127)		; (BR/BSB B label)
373		    (BYTE (8 ,(+ #x10 bit)))
374		    (BYTE (8 disp SIGNED)))
375		   ((-32767 32768)	; (BR/BSB W label)
376		    (BYTE (8 ,(+ #x30 bit)))
377		    (BYTE (16 (- disp 1) SIGNED)))
378		   ((() ())		; (JMP/JSB (@PCO L label))
379		    (BYTE (8 ,(+ #x16 bit)))
380		    (BYTE (4 15)
381			  (4 14))
382		    (BYTE (32 (- disp 4) SIGNED)))))
383
384		 (((@PCRO (? label) (? offset))) ; Kludge!
385		  (VARIABLE-WIDTH
386		   (disp `(+ ,offset (- ,label (+ *PC* 2))))
387		   ((-128 127)		; (BR/BSB B label)
388		    (BYTE (8 ,(+ #x10 bit)))
389		    (BYTE (8 disp SIGNED)))
390		   ((-32767 32768)	; (BR/BSB W label)
391		    (BYTE (8 ,(+ #x30 bit)))
392		    (BYTE (16 (- disp 1) SIGNED)))
393		   ((() ())		; (JMP/JSB (@PCO L label))
394		    (BYTE (8 ,(+ #x16 bit)))
395		    (BYTE (4 15)
396			  (4 14))
397		    (BYTE (32 (- disp 4) SIGNED))))))
398
399	       (DEFINE-INSTRUCTION ,namej
400		 (((? dst ea-a-b))
401		  (BYTE (8 ,(+ #x16 bit)))
402		  (OPERAND B dst)))))))))
403
404  (define-unconditional-transfer BR JMP #x1)
405  (define-unconditional-transfer BSB JSB #x0))
406
407(define-trivial-instruction RSB #x05)
408
409(define-instruction CALLG
410  (((? arglist ea-a-b) (? dst ea-a-b))
411   (BYTE (8 #xFA))
412   (OPERAND B arglist)
413   (OPERAND B dst)))
414
415(define-instruction CALLS
416  (((? narg ea-r-l) (? dst ea-a-b))
417   (BYTE (8 #xFB))
418   (OPERAND L narg)
419   (OPERAND B dst)))
420
421(define-trivial-instruction RET #x04)
422
423(define-instruction BLB
424  ((S (? src ea-r-l) (@PCO (? dest)))
425   (BYTE (8 #xE8))
426   (OPERAND L src)
427   (DISPLACEMENT (8 dest)))
428
429  ((S (? src ea-r-l) (@PCR (? dest)))
430   (BYTE (8 #xE8))
431   (OPERAND L src)
432   (DISPLACEMENT (8 `(- ,dest (+ *PC* 1)))))
433
434  ((C (? src ea-r-l) (@PCO (? dest)))
435   (BYTE (8 #xE9))
436   (OPERAND L src)
437   (DISPLACEMENT (8 dest)))
438
439  ((C (? src ea-r-l) (@PCR (? dest)))
440   (BYTE (8 #xE9))
441   (OPERAND L src)
442   (DISPLACEMENT (8 `(- ,dest (+ *PC* 1))))))
443
444(define-instruction BB
445  ((S (? pos ea-r-l) (? base ea-v-b) (@PCO (? dest)))
446   (BYTE (8 #xE0))
447   (OPERAND L pos)
448   (OPERAND B base)
449   (DISPLACEMENT (8 dest)))
450
451  ((S (? pos ea-r-l) (? base ea-v-b) (@PCR (? dest)))
452   (BYTE (8 #xE0))
453   (OPERAND L pos)
454   (OPERAND B base)
455   (DISPLACEMENT (8 `(- ,dest (+ *PC* 1)))))
456
457  ((C (? pos ea-r-l) (? base ea-v-b) (@PCO (? dest)))
458   (BYTE (8 #xE1))
459   (OPERAND L pos)
460   (OPERAND B base)
461   (DISPLACEMENT (8 dest)))
462
463  ((C (? pos ea-r-l) (? base ea-v-b) (@PCR (? dest)))
464   (BYTE (8 #xE1))
465   (OPERAND L pos)
466   (OPERAND B base)
467   (DISPLACEMENT (8 `(- ,dest (+ *PC* 1)))))
468
469  ((S S (? pos ea-r-l) (? base ea-v-b) (@PCO (? dest)))
470   (BYTE (8 #xE2))
471   (OPERAND L pos)
472   (OPERAND B base)
473   (DISPLACEMENT (8 dest)))
474
475  ((S S (? pos ea-r-l) (? base ea-v-b) (@PCR (? dest)))
476   (BYTE (8 #xE2))
477   (OPERAND L pos)
478   (OPERAND B base)
479   (DISPLACEMENT (8 `(- ,dest (+ *PC* 1)))))
480
481  ((C S (? pos ea-r-l) (? base ea-v-b) (@PCO (? dest)))
482   (BYTE (8 #xE3))
483   (OPERAND L pos)
484   (OPERAND B base)
485   (DISPLACEMENT (8 dest)))
486
487  ((C S (? pos ea-r-l) (? base ea-v-b) (@PCR (? dest)))
488   (BYTE (8 #xE3))
489   (OPERAND L pos)
490   (OPERAND B base)
491   (DISPLACEMENT (8 `(- ,dest (+ *PC* 1)))))
492
493  ((S C (? pos ea-r-l) (? base ea-v-b) (@PCO (? dest)))
494   (BYTE (8 #xE4))
495   (OPERAND L pos)
496   (OPERAND B base)
497   (DISPLACEMENT (8 dest)))
498
499  ((S C (? pos ea-r-l) (? base ea-v-b) (@PCR (? dest)))
500   (BYTE (8 #xE4))
501   (OPERAND L pos)
502   (OPERAND B base)
503   (DISPLACEMENT (8 `(- ,dest (+ *PC* 1)))))
504
505  ((C C (? pos ea-r-l) (? base ea-v-b) (@PCO (? dest)))
506   (BYTE (8 #xE5))
507   (OPERAND L pos)
508   (OPERAND B base)
509   (DISPLACEMENT (8 dest)))
510
511  ((C C (? pos ea-r-l) (? base ea-v-b) (@PCR (? dest)))
512   (BYTE (8 #xE5))
513   (OPERAND L pos)
514   (OPERAND B base)
515   (DISPLACEMENT (8 `(- ,dest (+ *PC* 1)))))
516
517  ((S S I (? pos ea-r-l) (? base ea-v-b) (@PCO (? dest)))
518   (BYTE (8 #xE6))
519   (OPERAND L pos)
520   (OPERAND B base)
521   (DISPLACEMENT (8 dest)))
522
523  ((S S I (? pos ea-r-l) (? base ea-v-b) (@PCR (? dest)))
524   (BYTE (8 #xE6))
525   (OPERAND L pos)
526   (OPERAND B base)
527   (DISPLACEMENT (8 `(- ,dest (+ *PC* 1)))))
528
529  ((C C I (? pos ea-r-l) (? base ea-v-b) (@PCO (? dest)))
530   (BYTE (8 #xE7))
531   (OPERAND L pos)
532   (OPERAND B base)
533   (DISPLACEMENT (8 dest)))
534
535  ((C C I (? pos ea-r-l) (? base ea-v-b) (@PCR (? dest)))
536   (BYTE (8 #xE7))
537   (OPERAND L pos)
538   (OPERAND B base)
539   (DISPLACEMENT (8 `(- ,dest (+ *PC* 1))))))
540
541(define-instruction ACB
542  ((B (? limit ea-r-b) (? add ea-r-b) (? index ea-m-b) (@PCO (? dest)))
543   (BYTE (8 #x9D))
544   (OPERAND B limit)
545   (OPERAND B add)
546   (OPERAND B index)
547   (DISPLACEMENT (8 dest)))
548
549  ((B (? limit ea-r-b) (? add ea-r-b) (? index ea-m-b) (@PCR (? dest)))
550   (BYTE (8 #x9D))
551   (OPERAND B limit)
552   (OPERAND B add)
553   (OPERAND B index)
554   (DISPLACEMENT (8 `(- ,dest (+ *PC* 1)))))
555
556  ((W (? limit ea-r-w) (? add ea-r-w) (? index ea-m-w) (@PCO (? dest)))
557   (BYTE (8 #x3D))
558   (OPERAND W limit)
559   (OPERAND W add)
560   (OPERAND W index)
561   (DISPLACEMENT (8 dest)))
562
563  ((W (? limit ea-r-w) (? add ea-r-w) (? index ea-m-w) (@PCR (? dest)))
564   (BYTE (8 #x3D))
565   (OPERAND W limit)
566   (OPERAND W add)
567   (OPERAND W index)
568   (DISPLACEMENT (8 `(- ,dest (+ *PC* 1)))))
569
570  ((L (? limit ea-r-l) (? add ea-r-l) (? index ea-m-l) (@PCO (? dest)))
571   (BYTE (8 #xF1))
572   (OPERAND L limit)
573   (OPERAND L add)
574   (OPERAND L index)
575   (DISPLACEMENT (8 dest)))
576
577  ((L (? limit ea-r-l) (? add ea-r-l) (? index ea-m-l) (@PCR (? dest)))
578   (BYTE (8 #xF1))
579   (OPERAND L limit)
580   (OPERAND L add)
581   (OPERAND L index)
582   (DISPLACEMENT (8 `(- ,dest (+ *PC* 1)))))
583
584  ((F (? limit ea-r-f) (? add ea-r-f) (? index ea-m-f) (@PCO (? dest)))
585   (BYTE (8 #x4F))
586   (OPERAND F limit)
587   (OPERAND F add)
588   (OPERAND F index)
589   (DISPLACEMENT (8 dest)))
590
591  ((F (? limit ea-r-f) (? add ea-r-f) (? index ea-m-f) (@PCR (? dest)))
592   (BYTE (8 #x4F))
593   (OPERAND F limit)
594   (OPERAND F add)
595   (OPERAND F index)
596   (DISPLACEMENT (8 `(- ,dest (+ *PC* 1)))))
597
598  ((D (? limit ea-r-d) (? add ea-r-d) (? index ea-m-d) (@PCO (? dest)))
599   (BYTE (8 #x6F))
600   (OPERAND D limit)
601   (OPERAND D add)
602   (OPERAND D index)
603   (DISPLACEMENT (8 dest)))
604
605  ((D (? limit ea-r-d) (? add ea-r-d) (? index ea-m-d) (@PCR (? dest)))
606   (BYTE (8 #x6F))
607   (OPERAND D limit)
608   (OPERAND D add)
609   (OPERAND D index)
610   (DISPLACEMENT (8 `(- ,dest (+ *PC* 1)))))
611
612  ((G (? limit ea-r-g) (? add ea-r-g) (? index ea-m-g) (@PCO (? dest)))
613   (BYTE (16 #x4FFD))
614   (OPERAND G limit)
615   (OPERAND G add)
616   (OPERAND G index)
617   (DISPLACEMENT (8 dest)))
618
619  ((G (? limit ea-r-g) (? add ea-r-g) (? index ea-m-g) (@PCR (? dest)))
620   (BYTE (16 #x4FFD))
621   (OPERAND G limit)
622   (OPERAND G add)
623   (OPERAND G index)
624   (DISPLACEMENT (8 `(- ,dest (+ *PC* 1)))))
625
626  ((H (? limit ea-r-h) (? add ea-r-h) (? index ea-m-h) (@PCO (? dest)))
627   (BYTE (16 #x6FFD))
628   (OPERAND H limit)
629   (OPERAND H add)
630   (OPERAND H index)
631   (DISPLACEMENT (8 dest)))
632
633  ((H (? limit ea-r-h) (? add ea-r-h) (? index ea-m-h) (@PCR (? dest)))
634   (BYTE (16 #x6FFD))
635   (OPERAND H limit)
636   (OPERAND H add)
637   (OPERAND H index)
638   (DISPLACEMENT (8 `(- ,dest (+ *PC* 1))))))
639
640(define-instruction AOB
641  ((LSS (? limit ea-r-l) (? index ea-m-l) (@PCO (? dest)))
642   (BYTE (8 #xF2))
643   (OPERAND L limit)
644   (OPERAND L index)
645   (DISPLACEMENT (8 dest)))
646
647  ((LSS (? limit ea-r-l) (? index ea-m-l) (@PCR (? dest)))
648   (BYTE (8 #xF2))
649   (OPERAND L limit)
650   (OPERAND L index)
651   (DISPLACEMENT (8 `(- ,dest (+ *PC* 1)))))
652
653  ((LEQ (? limit ea-r-l) (? index ea-m-l) (@PCO (? dest)))
654   (BYTE (8 #xF3))
655   (OPERAND L limit)
656   (OPERAND L index)
657   (DISPLACEMENT (8 dest)))
658
659  ((LEQ (? limit ea-r-l) (? index ea-m-l) (@PCR (? dest)))
660   (BYTE (8 #xF3))
661   (OPERAND L limit)
662   (OPERAND L index)
663   (DISPLACEMENT (8 `(- ,dest (+ *PC* 1))))))
664
665(define-instruction SOB
666  ((GEQ (? index ea-m-l) (@PCO (? dest)))
667   (BYTE (8 #xF4))
668   (OPERAND L index)
669   (DISPLACEMENT (8 dest)))
670
671  ((GEQ (? index ea-m-l) (@PCR (? dest)))
672   (BYTE (8 #xF4))
673   (OPERAND L index)
674   (DISPLACEMENT (8 `(- ,dest (+ *PC* 1)))))
675
676  ((GTR (? index ea-m-l) (@PCO (? dest)))
677   (BYTE (8 #xF5))
678   (OPERAND L index)
679   (DISPLACEMENT (8 dest)))
680
681  ((GTR (? index ea-m-l) (@PCR (? dest)))
682   (BYTE (8 #xF5))
683   (OPERAND L index)
684   (DISPLACEMENT (8 `(- ,dest (+ *PC* 1))))))
685
686;; NOTE: The displacements must be placed separately on the
687;; instruction stream after the instruction.
688;;
689;; For example:
690;;
691;; (CASE B (R 0) (& 5) (& 2))
692;; (LABEL case-begin)
693;; (WORD `(- case-5 case-begin))
694;; (WORD `(- case-6 case-begin))
695;; (WORD `(- case-7 case-begin))
696;; <fall through if out of range>
697
698(define-instruction CASE
699  ((B (? selector ea-r-b) (? base ea-r-b) (? limit ea-r-b))
700   (BYTE (8 #x8F))
701   (OPERAND B selector)
702   (OPERAND B base)
703   (OPERAND B limit))
704
705  ((W (? selector ea-r-w) (? base ea-r-w) (? limit ea-r-w))
706   (BYTE (8 #xAF))
707   (OPERAND W selector)
708   (OPERAND W base)
709   (OPERAND W limit))
710
711  ((L (? selector ea-r-l) (? base ea-r-l) (? limit ea-r-l))
712   (BYTE (8 #xCF))
713   (OPERAND L selector)
714   (OPERAND L base)
715   (OPERAND L limit)))
716
717;;;; BCD instructions (Chap 15.)
718
719(let-syntax
720    ((define-add/sub-bcd-instruction
721       (sc-macro-transformer
722	(lambda (form environment)
723	  environment
724	  (let ((opcode4 (caddr form)))
725	    `(DEFINE-INSTRUCTION ,(cadr form)
726	       (((? oplen ea-r-w) (? op ea-a-b)
727				  (? reslen ea-r-w) (? res ea-a-b))
728		(BYTE (8 ,opcode4))
729		(OPERAND W oplen)
730		(OPERAND B op)
731		(OPERAND W reslen)
732		(OPERAND B res))
733
734	       (((? op1len ea-r-w) (? op1 ea-a-b)
735				   (? op2len ea-r-w) (? op2 ea-a-b)
736				   (? reslen ea-r-w) (? res ea-a-b))
737		(BYTE (8 ,(1+ opcode4)))
738		(OPERAND W op1len)
739		(OPERAND B op1)
740		(OPERAND W op2len)
741		(OPERAND B op2)
742		(OPERAND W reslen)
743		(OPERAND B res))))))))
744
745  (define-add/sub-bcd-instruction ADDP #x20)
746  (define-add/sub-bcd-instruction SUBP #x22))
747
748(let-syntax
749    ((define-add/sub-bcd-instruction
750       (sc-macro-transformer
751	(lambda (form environment)
752	  environment
753	  `(DEFINE-INSTRUCTION ,(cadr form)
754	     (((? op1len ea-r-w) (? op1 ea-a-b)
755	       (? op2len ea-r-w) (? op2 ea-a-b)
756	       (? reslen ea-r-w) (? res ea-a-b))
757	      (BYTE (8 ,(caddr form)))
758	      (OPERAND W op1len)
759	      (OPERAND B op1)
760	      (OPERAND W op2len)
761	      (OPERAND B op2)
762	      (OPERAND W reslen)
763	      (OPERAND B res)))))))
764
765  (define-add/sub-bcd-instruction MULP #x25)
766  (define-add/sub-bcd-instruction DIVP #x27))
767
768(define-instruction CMPP
769  (((? len ea-r-w) (? src1 ea-a-b) (? src2 ea-a-b))
770   (BYTE (8 #x35))
771   (OPERAND W len)
772   (OPERAND B src1)
773   (OPERAND B src2))
774
775  (((? len1 ea-r-w) (? src1 ea-a-b) (? len2 ea-r-w) (? src2 ea-a-b))
776   (BYTE (8 #x37))
777   (OPERAND W len1)
778   (OPERAND B src1)
779   (OPERAND W len2)
780   (OPERAND B src2)))
781
782(define-instruction ASHP
783  (((? srclen ea-r-w) (? src ea-a-b)
784    (? round ea-r-b)
785    (? dstlen ea-r-w) (? dst ea-a-b))
786   (BYTE (8 #xF8))
787   (OPERAND W srclen)
788   (OPERAND B src)
789   (OPERAND B round)
790   (OPERAND W dstlen)
791   (OPERAND B dst)))
792
793(define-instruction MOVP
794  (((? len ea-r-w) (? src ea-a-b) (? dst ea-a-b))
795   (BYTE (8 #x34))
796   (OPERAND W len)
797   (OPERAND B src)
798   (OPERAND B dst)))
799
800(define-instruction CVTLP
801  (((? src ea-r-l) (? len ea-r-w) (? dst ea-a-b))
802   (BYTE (8 #xF9))
803   (OPERAND L src)
804   (OPERAND W len)
805   (OPERAND B dst)))
806
807(define-instruction CVTPL
808  (((? len ea-r-w) (? src ea-a-b) (? dst ea-w-l))
809   (BYTE (8 #x36))
810   (OPERAND W len)
811   (OPERAND B src)
812   (OPERAND L dst)))
813
814(let-syntax
815    ((define-cvt-trailing-instruction
816       (sc-macro-transformer
817	(lambda (form environment)
818	  environment
819	  `(DEFINE-INSTRUCTION ,(cadr form)
820	     (((? srclen ea-r-w) (? src ea-a-b)
821	       (? tbl ea-a-b)
822	       (? dstlen ea-r-w) (? dst ea-a-b))
823	      (BYTE (8 ,(caddr form)))
824	      (OPERAND W srclen)
825	      (OPERAND B src)
826	      (OPERAND B tbl)
827	      (OPERAND W dstlen)
828	      (OPERAND B dst)))))))
829
830  (define-cvt-trailing-instruction CVTPT #x24)
831  (define-cvt-trailing-instruction CVTTT #x26))
832
833(let-syntax
834    ((define-cvt-separate-instruction
835       (sc-macro-transformer
836	(lambda (form environment)
837	  environment
838	  `(DEFINE-INSTRUCTION ,(cadr form)
839	     (((? srclen ea-r-w) (? src ea-a-b)
840	       (? dstlen ea-r-w) (? dst ea-a-b))
841	      (BYTE (8 ,(caddr form)))
842	      (OPERAND W srclen)
843	      (OPERAND B src)
844	      (OPERAND W dstlen)
845	      (OPERAND B dst)))))))
846
847  (define-cvt-separate-instruction CVTPS #x08)
848  (define-cvt-separate-instruction CVTSP #x09))