1/* rl78-parse.y  Renesas RL78 parser
2   Copyright (C) 2011-2022 Free Software Foundation, Inc.
3
4   This file is part of GAS, the GNU Assembler.
5
6   GAS is free software; you can redistribute it and/or modify
7   it under the terms of the GNU General Public License as published by
8   the Free Software Foundation; either version 3, or (at your option)
9   any later version.
10
11   GAS is distributed in the hope that it will be useful,
12   but WITHOUT ANY WARRANTY; without even the implied warranty of
13   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14   GNU General Public License for more details.
15
16   You should have received a copy of the GNU General Public License
17   along with GAS; see the file COPYING.  If not, write to the Free
18   Software Foundation, 51 Franklin Street - Fifth Floor, Boston, MA
19   02110-1301, USA.  */
20%{
21
22#include "as.h"
23#include "safe-ctype.h"
24#include "rl78-defs.h"
25
26static int rl78_lex (void);
27
28/* Ok, here are the rules for using these macros...
29
30   B*() is used to specify the base opcode bytes.  Fields to be filled
31        in later, leave zero.  Call this first.
32
33   F() and FE() are used to fill in fields within the base opcode bytes.  You MUST
34        call B*() before any F() or FE().
35
36   [UN]*O*(), PC*() appends operands to the end of the opcode.  You
37        must call P() and B*() before any of these, so that the fixups
38        have the right byte location.
39        O = signed, UO = unsigned, NO = negated, PC = pcrel
40
41   IMM() adds an immediate and fills in the field for it.
42   NIMM() same, but negates the immediate.
43   NBIMM() same, but negates the immediate, for sbb.
44   DSP() adds a displacement, and fills in the field for it.
45
46   Note that order is significant for the O, IMM, and DSP macros, as
47   they append their data to the operand buffer in the order that you
48   call them.
49
50   Use "disp" for displacements whenever possible; this handles the
51   "0" case properly.  */
52
53#define B1(b1)             rl78_base1 (b1)
54#define B2(b1, b2)         rl78_base2 (b1, b2)
55#define B3(b1, b2, b3)     rl78_base3 (b1, b2, b3)
56#define B4(b1, b2, b3, b4) rl78_base4 (b1, b2, b3, b4)
57
58/* POS is bits from the MSB of the first byte to the LSB of the last byte.  */
59#define F(val,pos,sz)      rl78_field (val, pos, sz)
60#define FE(exp,pos,sz)	   rl78_field (exp_val (exp), pos, sz);
61
62#define O1(v)              rl78_op (v, 1, RL78REL_DATA)
63#define O2(v)              rl78_op (v, 2, RL78REL_DATA)
64#define O3(v)              rl78_op (v, 3, RL78REL_DATA)
65#define O4(v)              rl78_op (v, 4, RL78REL_DATA)
66
67#define PC1(v)             rl78_op (v, 1, RL78REL_PCREL)
68#define PC2(v)             rl78_op (v, 2, RL78REL_PCREL)
69#define PC3(v)             rl78_op (v, 3, RL78REL_PCREL)
70
71#define IMM(v,pos)	   F (immediate (v, RL78REL_SIGNED, pos), pos, 2); \
72			   if (v.X_op != O_constant && v.X_op != O_big) rl78_linkrelax_imm (pos)
73#define NIMM(v,pos)	   F (immediate (v, RL78REL_NEGATIVE, pos), pos, 2)
74#define NBIMM(v,pos)	   F (immediate (v, RL78REL_NEGATIVE_BORROW, pos), pos, 2)
75#define DSP(v,pos,msz)	   if (!v.X_md) rl78_relax (RL78_RELAX_DISP, pos); \
76			   else rl78_linkrelax_dsp (pos); \
77			   F (displacement (v, msz), pos, 2)
78
79#define id24(a,b2,b3)	   B3 (0xfb+a, b2, b3)
80
81static int         expr_is_sfr (expressionS);
82static int         expr_is_saddr (expressionS);
83static int         expr_is_word_aligned (expressionS);
84static int         exp_val (expressionS exp);
85
86static int    need_flag = 0;
87static int    rl78_in_brackets = 0;
88static int    rl78_last_token = 0;
89static char * rl78_init_start;
90static char * rl78_last_exp_start = 0;
91static int    rl78_bit_insn = 0;
92
93#define YYDEBUG 1
94#define YYERROR_VERBOSE 1
95
96#define NOT_SADDR  rl78_error ("Expression not 0xFFE20 to 0xFFF1F")
97#define SA(e) if (!expr_is_saddr (e)) NOT_SADDR;
98
99#define SET_SA(e) e.X_md = BFD_RELOC_RL78_SADDR
100
101#define NOT_SFR  rl78_error ("Expression not 0xFFF00 to 0xFFFFF")
102#define SFR(e) if (!expr_is_sfr (e)) NOT_SFR;
103
104#define NOT_SFR_OR_SADDR  rl78_error ("Expression not 0xFFE20 to 0xFFFFF")
105
106#define NOT_ES if (rl78_has_prefix()) rl78_error ("ES: prefix not allowed here");
107
108#define WA(x) if (!expr_is_word_aligned (x)) rl78_error ("Expression not word-aligned");
109
110#define ISA_G10(s) if (!rl78_isa_g10()) rl78_error (s " is only supported on the G10")
111#define ISA_G13(s) if (!rl78_isa_g13()) rl78_error (s " is only supported on the G13")
112#define ISA_G14(s) if (!rl78_isa_g14()) rl78_error (s " is only supported on the G14")
113
114static void check_expr_is_bit_index (expressionS);
115#define Bit(e) check_expr_is_bit_index (e);
116
117/* Returns TRUE (non-zero) if the expression is a constant in the
118   given range.  */
119static int check_expr_is_const (expressionS, int vmin, int vmax);
120
121/* Convert a "regb" value to a "reg_xbc" value.  Error if other
122   registers are passed.  Needed to avoid reduce-reduce conflicts.  */
123static int
124reg_xbc (int reg)
125{
126  switch (reg)
127    {
128      case 0: /* X */
129        return 0x10;
130      case 3: /* B */
131        return 0x20;
132      case 2: /* C */
133        return 0x30;
134      default:
135        rl78_error ("Only X, B, or C allowed here");
136	return 0;
137    }
138}
139
140%}
141
142%name-prefix="rl78_"
143
144%union {
145  int regno;
146  expressionS exp;
147}
148
149%type <regno> regb regb_na regw regw_na FLAG sfr
150%type <regno> A X B C D E H L AX BC DE HL
151%type <exp> EXPR
152
153%type <regno> addsub addsubw andor1 bt_bf setclr1 oneclrb oneclrw
154%type <regno> incdec incdecw
155
156%token A X B C D E H L AX BC DE HL
157%token SPL SPH PSW CS ES PMC MEM
158%token FLAG SP CY
159%token RB0 RB1 RB2 RB3
160
161%token EXPR UNKNOWN_OPCODE IS_OPCODE
162
163%token DOT_S DOT_B DOT_W DOT_L DOT_A DOT_UB DOT_UW
164
165%token ADD ADDC ADDW AND_ AND1
166/* BC is also a register pair */
167%token BF BH BNC BNH BNZ BR BRK BRK1 BT BTCLR BZ
168%token CALL CALLT CLR1 CLRB CLRW CMP CMP0 CMPS CMPW
169%token DEC DECW DI DIVHU DIVWU
170%token EI
171%token HALT
172%token INC INCW
173%token MACH MACHU MOV MOV1 MOVS MOVW MULH MULHU MULU
174%token NOP NOT1
175%token ONEB ONEW OR OR1
176%token POP PUSH
177%token RET RETI RETB ROL ROLC ROLWC ROR RORC
178%token SAR SARW SEL SET1 SHL SHLW SHR SHRW
179%token   SKC SKH SKNC SKNH SKNZ SKZ STOP SUB SUBC SUBW
180%token XCH XCHW XOR XOR1
181
182%%
183/* ====================================================================== */
184
185statement :
186
187	  UNKNOWN_OPCODE
188	  { as_bad (_("Unknown opcode: %s"), rl78_init_start); }
189
190/* The opcodes are listed in approximately alphabetical order.  */
191
192/* For reference:
193
194  sfr  = special function register - symbol, 0xFFF00 to 0xFFFFF
195  sfrp = special function register - symbol, 0xFFF00 to 0xFFFFE, even only
196  saddr  = 0xFFE20 to 0xFFF1F
197  saddrp = 0xFFE20 to 0xFFF1E, even only
198
199  addr20 = 0x00000 to 0xFFFFF
200  addr16 = 0x00000 to 0x0FFFF, even only for 16-bit ops
201  addr5  = 0x00000 to 0x000BE, even only
202*/
203
204/* ---------------------------------------------------------------------- */
205
206/* addsub is ADD, ADDC, SUB, SUBC, AND, OR, XOR, and parts of CMP.  */
207
208	| addsub A ',' '#' EXPR
209	  { B1 (0x0c|$1); O1 ($5); }
210
211	| addsub EXPR {SA($2)} ',' '#' EXPR
212	  { B1 (0x0a|$1); SET_SA ($2); O1 ($2); O1 ($6); }
213
214	| addsub A ',' A
215	  { B2 (0x61, 0x01|$1); }
216
217	| addsub A ',' regb_na
218	  { B2 (0x61, 0x08|$1); F ($4, 13, 3); }
219
220	| addsub regb_na ',' A
221	  { B2 (0x61, 0x00|$1); F ($2, 13, 3); }
222
223	| addsub A ',' EXPR {SA($4)}
224	  { B1 (0x0b|$1); SET_SA ($4); O1 ($4); }
225
226	| addsub A ',' opt_es '!' EXPR
227	  { B1 (0x0f|$1); O2 ($6); rl78_linkrelax_addr16 (); }
228
229	| addsub A ',' opt_es '[' HL ']'
230	  { B1 (0x0d|$1); }
231
232	| addsub A ',' opt_es '[' HL '+' EXPR ']'
233	  { B1 (0x0e|$1); O1 ($8); }
234
235	| addsub A ',' opt_es '[' HL '+' B ']'
236	  { B2 (0x61, 0x80|$1); }
237
238	| addsub A ',' opt_es '[' HL '+' C ']'
239	  { B2 (0x61, 0x82|$1); }
240
241	| addsub opt_es '!' EXPR ',' '#' EXPR
242	  { if ($1 != 0x40)
243	      { rl78_error ("Only CMP takes these operands"); }
244	    else
245	      { B1 (0x00|$1); O2 ($4); O1 ($7); rl78_linkrelax_addr16 (); }
246	  }
247
248/* ---------------------------------------------------------------------- */
249
250	| addsubw AX ',' '#' EXPR
251	  { B1 (0x04|$1); O2 ($5); }
252
253	| addsubw AX ',' regw
254	  { B1 (0x01|$1); F ($4, 5, 2); }
255
256	| addsubw AX ',' EXPR {SA($4)}
257	  { B1 (0x06|$1); SET_SA ($4); O1 ($4); }
258
259	| addsubw AX ',' opt_es '!' EXPR
260	  { B1 (0x02|$1); O2 ($6); rl78_linkrelax_addr16 (); }
261
262	| addsubw AX ',' opt_es '[' HL '+' EXPR ']'
263	  { B2 (0x61, 0x09|$1); O1 ($8); }
264
265	| addsubw AX ',' opt_es '[' HL ']'
266	  { B3 (0x61, 0x09|$1, 0); }
267
268	| addsubw SP ',' '#' EXPR
269	  { B1 ($1 ? 0x20 : 0x10); O1 ($5);
270	    if ($1 == 0x40)
271	      rl78_error ("CMPW SP,#imm not allowed");
272	  }
273
274/* ---------------------------------------------------------------------- */
275
276	| andor1 CY ',' sfr '.' EXPR {Bit($6)}
277	  { B3 (0x71, 0x08|$1, $4); FE ($6, 9, 3); }
278
279	| andor1 CY ',' EXPR '.' EXPR {Bit($6)}
280	  { if (expr_is_sfr ($4))
281	      { B2 (0x71, 0x08|$1); FE ($6, 9, 3); O1 ($4); }
282	    else if (expr_is_saddr ($4))
283	      { B2 (0x71, 0x00|$1); FE ($6, 9, 3); SET_SA ($4); O1 ($4); }
284	    else
285	      NOT_SFR_OR_SADDR;
286	  }
287
288	| andor1 CY ',' A '.' EXPR {Bit($6)}
289	  { B2 (0x71, 0x88|$1);  FE ($6, 9, 3); }
290
291	| andor1 CY ',' opt_es '[' HL ']' '.' EXPR {Bit($9)}
292	  { B2 (0x71, 0x80|$1);  FE ($9, 9, 3); }
293
294/* ---------------------------------------------------------------------- */
295
296	| BC '$' EXPR
297	  { B1 (0xdc); PC1 ($3); rl78_linkrelax_branch (); }
298
299	| BNC '$' EXPR
300	  { B1 (0xde); PC1 ($3); rl78_linkrelax_branch (); }
301
302	| BZ '$' EXPR
303	  { B1 (0xdd); PC1 ($3); rl78_linkrelax_branch (); }
304
305	| BNZ '$' EXPR
306	  { B1 (0xdf); PC1 ($3); rl78_linkrelax_branch (); }
307
308	| BH '$' EXPR
309	  { B2 (0x61, 0xc3); PC1 ($3); rl78_linkrelax_branch (); }
310
311	| BNH '$' EXPR
312	  { B2 (0x61, 0xd3); PC1 ($3); rl78_linkrelax_branch (); }
313
314/* ---------------------------------------------------------------------- */
315
316	| bt_bf sfr '.' EXPR ',' '$' EXPR
317	  { B3 (0x31, 0x80|$1, $2); FE ($4, 9, 3); PC1 ($7); }
318
319	| bt_bf EXPR '.' EXPR ',' '$' EXPR
320	  { if (expr_is_sfr ($2))
321	      { B2 (0x31, 0x80|$1); FE ($4, 9, 3); O1 ($2); PC1 ($7); }
322	    else if (expr_is_saddr ($2))
323	      { B2 (0x31, 0x00|$1); FE ($4, 9, 3); SET_SA ($2); O1 ($2); PC1 ($7); }
324	    else
325	      NOT_SFR_OR_SADDR;
326	  }
327
328	| bt_bf A '.' EXPR ',' '$' EXPR
329	  { B2 (0x31, 0x01|$1); FE ($4, 9, 3); PC1 ($7); }
330
331	| bt_bf opt_es '[' HL ']' '.' EXPR ',' '$' EXPR
332	  { B2 (0x31, 0x81|$1); FE ($7, 9, 3); PC1 ($10); }
333
334/* ---------------------------------------------------------------------- */
335
336	| BR AX
337	  { B2 (0x61, 0xcb); }
338
339	| BR '$' EXPR
340	  { B1 (0xef); PC1 ($3); rl78_linkrelax_branch (); }
341
342	| BR '$' '!' EXPR
343	  { B1 (0xee); PC2 ($4); rl78_linkrelax_branch (); }
344
345	| BR '!' EXPR
346	  { B1 (0xed); O2 ($3); rl78_linkrelax_branch (); }
347
348	| BR '!' '!' EXPR
349	  { B1 (0xec); O3 ($4); rl78_linkrelax_branch (); }
350
351/* ---------------------------------------------------------------------- */
352
353	| BRK
354	  { B2 (0x61, 0xcc); }
355
356	| BRK1
357	  { B1 (0xff); }
358
359/* ---------------------------------------------------------------------- */
360
361	| CALL regw
362	  { B2 (0x61, 0xca); F ($2, 10, 2); }
363
364	| CALL '$' '!' EXPR
365	  { B1 (0xfe); PC2 ($4); }
366
367	| CALL '!' EXPR
368	  { B1 (0xfd); O2 ($3); }
369
370	| CALL '!' '!' EXPR
371	  { B1 (0xfc); O3 ($4); rl78_linkrelax_branch (); }
372
373	| CALLT '[' EXPR ']'
374	  { if ($3.X_op != O_constant)
375	      rl78_error ("CALLT requires a numeric address");
376	    else
377	      {
378	        int i = $3.X_add_number;
379		if (i < 0x80 || i > 0xbe)
380		  rl78_error ("CALLT address not 0x80..0xbe");
381		else if (i & 1)
382		  rl78_error ("CALLT address not even");
383		else
384		  {
385		    B2 (0x61, 0x84);
386	    	    F ((i >> 1) & 7, 9, 3);
387	    	    F ((i >> 4) & 7, 14, 2);
388		  }
389	      }
390	  }
391
392/* ---------------------------------------------------------------------- */
393
394	| setclr1 CY
395	  { B2 (0x71, $1 ? 0x88 : 0x80); }
396
397	| setclr1 sfr '.' EXPR
398	  { B3 (0x71, 0x0a|$1, $2); FE ($4, 9, 3); }
399
400	| setclr1 EXPR '.' EXPR
401	  { if (expr_is_sfr ($2))
402	      { B2 (0x71, 0x0a|$1); FE ($4, 9, 3); O1 ($2); }
403	    else if (expr_is_saddr ($2))
404	      { B2 (0x71, 0x02|$1); FE ($4, 9, 3); SET_SA ($2); O1 ($2); }
405	    else
406	      NOT_SFR_OR_SADDR;
407	  }
408
409	| setclr1 A '.' EXPR
410	  { B2 (0x71, 0x8a|$1);  FE ($4, 9, 3); }
411
412	| setclr1 opt_es '!' EXPR '.' EXPR
413	  { B2 (0x71, 0x00+$1*0x08); FE ($6, 9, 3); O2 ($4); rl78_linkrelax_addr16 (); }
414
415	| setclr1 opt_es '[' HL ']' '.' EXPR
416	  { B2 (0x71, 0x82|$1); FE ($7, 9, 3); }
417
418/* ---------------------------------------------------------------------- */
419
420	| oneclrb A
421	  { B1 (0xe1|$1); }
422	| oneclrb X
423	  { B1 (0xe0|$1); }
424	| oneclrb B
425	  { B1 (0xe3|$1); }
426	| oneclrb C
427	  { B1 (0xe2|$1); }
428
429	| oneclrb EXPR {SA($2)}
430	  { B1 (0xe4|$1); SET_SA ($2); O1 ($2); }
431
432	| oneclrb opt_es '!' EXPR
433	  { B1 (0xe5|$1); O2 ($4); rl78_linkrelax_addr16 (); }
434
435/* ---------------------------------------------------------------------- */
436
437	| oneclrw AX
438	  { B1 (0xe6|$1); }
439	| oneclrw BC
440	  { B1 (0xe7|$1); }
441
442/* ---------------------------------------------------------------------- */
443
444	| CMP0 A
445	  { B1 (0xd1); }
446
447	| CMP0 X
448	  { B1 (0xd0); }
449
450	| CMP0 B
451	  { B1 (0xd3); }
452
453	| CMP0 C
454	  { B1 (0xd2); }
455
456	| CMP0 EXPR {SA($2)}
457	  { B1 (0xd4); SET_SA ($2); O1 ($2); }
458
459	| CMP0 opt_es '!' EXPR
460	  { B1 (0xd5); O2 ($4); rl78_linkrelax_addr16 (); }
461
462/* ---------------------------------------------------------------------- */
463
464	| CMPS X ',' opt_es '[' HL '+' EXPR ']'
465	  { B2 (0x61, 0xde); O1 ($8); }
466
467/* ---------------------------------------------------------------------- */
468
469	| incdec regb
470	  { B1 (0x80|$1); F ($2, 5, 3); }
471
472	| incdec EXPR {SA($2)}
473	  { B1 (0xa4|$1); SET_SA ($2); O1 ($2); }
474	| incdec '!' EXPR
475	  { B1 (0xa0|$1); O2 ($3); rl78_linkrelax_addr16 (); }
476	| incdec ES ':' '!' EXPR
477	  { B2 (0x11, 0xa0|$1); O2 ($5); }
478	| incdec '[' HL '+' EXPR ']'
479	  { B2 (0x61, 0x59+$1); O1 ($5); }
480	| incdec ES ':' '[' HL '+' EXPR ']'
481	  { B3 (0x11, 0x61, 0x59+$1); O1 ($7); }
482
483/* ---------------------------------------------------------------------- */
484
485	| incdecw regw
486	  { B1 (0xa1|$1); F ($2, 5, 2); }
487
488	| incdecw EXPR {SA($2)}
489	  { B1 (0xa6|$1); SET_SA ($2); O1 ($2); }
490
491	| incdecw opt_es '!' EXPR
492	  { B1 (0xa2|$1); O2 ($4); rl78_linkrelax_addr16 (); }
493
494	| incdecw opt_es '[' HL '+' EXPR ']'
495	  { B2 (0x61, 0x79+$1); O1 ($6); }
496
497/* ---------------------------------------------------------------------- */
498
499	| DI
500	  { B3 (0x71, 0x7b, 0xfa); }
501
502	| EI
503	  { B3 (0x71, 0x7a, 0xfa); }
504
505/* ---------------------------------------------------------------------- */
506
507	| MULHU { ISA_G14 ("MULHU"); }
508	  { B3 (0xce, 0xfb, 0x01); }
509
510	| MULH { ISA_G14 ("MULH"); }
511	  { B3 (0xce, 0xfb, 0x02); }
512
513	| MULU X
514	  { B1 (0xd6); }
515
516	| DIVHU { ISA_G14 ("DIVHU"); }
517	  { B3 (0xce, 0xfb, 0x03); }
518
519/* Note that the DIVWU encoding was changed from [0xce,0xfb,0x04] to
520   [0xce,0xfb,0x0b].  Different versions of the Software Manual exist
521   with the same version number, but varying encodings.  The version
522   here matches the hardware.  */
523
524	| DIVWU { ISA_G14 ("DIVWU"); }
525	  { B3 (0xce, 0xfb, 0x0b); }
526
527	| MACHU { ISA_G14 ("MACHU"); }
528	  { B3 (0xce, 0xfb, 0x05); }
529
530	| MACH { ISA_G14 ("MACH"); }
531	  { B3 (0xce, 0xfb, 0x06); }
532
533/* ---------------------------------------------------------------------- */
534
535	| HALT
536	  { B2 (0x61, 0xed); }
537
538/* ---------------------------------------------------------------------- */
539/* Note that opt_es is included even when it's not an option, to avoid
540   shift/reduce conflicts.  The NOT_ES macro produces an error if ES:
541   is given by the user.  */
542
543	| MOV A ',' '#' EXPR
544	  { B1 (0x51); O1 ($5); }
545	| MOV regb_na ',' '#' EXPR
546	  { B1 (0x50); F($2, 5, 3); O1 ($5); }
547
548	| MOV sfr ',' '#' EXPR
549	  { if ($2 != 0xfd)
550	      { B2 (0xce, $2); O1 ($5); }
551	    else
552	      { B1 (0x41); O1 ($5); }
553	  }
554
555	| MOV opt_es EXPR ',' '#' EXPR  {NOT_ES}
556	  { if (expr_is_sfr ($3))
557	      { B1 (0xce); O1 ($3); O1 ($6); }
558	    else if (expr_is_saddr ($3))
559	      { B1 (0xcd); SET_SA ($3); O1 ($3); O1 ($6); }
560	    else
561	      NOT_SFR_OR_SADDR;
562	  }
563
564	| MOV '!' EXPR ',' '#' EXPR
565	  { B1 (0xcf); O2 ($3); O1 ($6); rl78_linkrelax_addr16 (); }
566
567	| MOV ES ':' '!' EXPR ',' '#' EXPR
568	  { B2 (0x11, 0xcf); O2 ($5); O1 ($8); }
569
570	| MOV regb_na ',' A
571	  { B1 (0x70); F ($2, 5, 3); }
572
573	| MOV A ',' regb_na
574	  { B1 (0x60); F ($4, 5, 3); }
575
576	| MOV opt_es EXPR ',' A  {NOT_ES}
577	  { if (expr_is_sfr ($3))
578	      { B1 (0x9e); O1 ($3); }
579	    else if (expr_is_saddr ($3))
580	      { B1 (0x9d); SET_SA ($3); O1 ($3); }
581	    else
582	      NOT_SFR_OR_SADDR;
583	  }
584
585	| MOV A ',' opt_es '!' EXPR
586	  { B1 (0x8f); O2 ($6); rl78_linkrelax_addr16 (); }
587
588	| MOV '!' EXPR ',' A
589	  { B1 (0x9f); O2 ($3); rl78_linkrelax_addr16 (); }
590
591	| MOV ES ':' '!' EXPR ',' A
592	  { B2 (0x11, 0x9f); O2 ($5); }
593
594	| MOV regb_na ',' opt_es '!' EXPR
595	  { B1 (0xc9|reg_xbc($2)); O2 ($6); rl78_linkrelax_addr16 (); }
596
597	| MOV A ',' opt_es EXPR  {NOT_ES}
598	  { if (expr_is_saddr ($5))
599	      { B1 (0x8d); SET_SA ($5); O1 ($5); }
600	    else if (expr_is_sfr ($5))
601	      { B1 (0x8e); O1 ($5); }
602	    else
603	      NOT_SFR_OR_SADDR;
604	  }
605
606	| MOV regb_na ',' opt_es EXPR {SA($5)} {NOT_ES}
607	  { B1 (0xc8|reg_xbc($2)); SET_SA ($5); O1 ($5); }
608
609	| MOV A ',' sfr
610	  { B2 (0x8e, $4); }
611
612	| MOV sfr ',' regb
613	  { if ($4 != 1)
614	      rl78_error ("Only A allowed here");
615	    else
616	      { B2 (0x9e, $2); }
617	  }
618
619	| MOV sfr ',' opt_es EXPR {SA($5)} {NOT_ES}
620	  { if ($2 != 0xfd)
621	      rl78_error ("Only ES allowed here");
622	    else
623	      { B2 (0x61, 0xb8); SET_SA ($5); O1 ($5); }
624	  }
625
626	| MOV A ',' opt_es '[' DE ']'
627	  { B1 (0x89); }
628
629	| MOV opt_es '[' DE ']' ',' A
630	  { B1 (0x99); }
631
632	| MOV opt_es '[' DE '+' EXPR ']' ',' '#' EXPR
633	  { B1 (0xca); O1 ($6); O1 ($10); }
634
635	| MOV A ',' opt_es '[' DE '+' EXPR ']'
636	  { B1 (0x8a); O1 ($8); }
637
638	| MOV opt_es '[' DE '+' EXPR ']' ',' A
639	  { B1 (0x9a); O1 ($6); }
640
641	| MOV A ',' opt_es '[' HL ']'
642	  { B1 (0x8b); }
643
644	| MOV opt_es '[' HL ']' ',' A
645	  { B1 (0x9b); }
646
647	| MOV opt_es '[' HL '+' EXPR ']' ',' '#' EXPR
648	  { B1 (0xcc); O1 ($6); O1 ($10); }
649
650	| MOV A ',' opt_es '[' HL '+' EXPR ']'
651	  { B1 (0x8c); O1 ($8); }
652
653	| MOV opt_es '[' HL '+' EXPR ']' ',' A
654	  { B1 (0x9c); O1 ($6); }
655
656	| MOV A ',' opt_es '[' HL '+' B ']'
657	  { B2 (0x61, 0xc9); }
658
659	| MOV opt_es '[' HL '+' B ']' ',' A
660	  { B2 (0x61, 0xd9); }
661
662	| MOV A ',' opt_es '[' HL '+' C ']'
663	  { B2 (0x61, 0xe9); }
664
665	| MOV opt_es '[' HL '+' C ']' ',' A
666	  { B2 (0x61, 0xf9); }
667
668	| MOV opt_es EXPR '[' B ']' ',' '#' EXPR
669	  { B1 (0x19); O2 ($3); O1 ($9); }
670
671	| MOV A ',' opt_es EXPR '[' B ']'
672	  { B1 (0x09); O2 ($5); }
673
674	| MOV opt_es EXPR '[' B ']' ',' A
675	  { B1 (0x18); O2 ($3); }
676
677	| MOV opt_es EXPR '[' C ']' ',' '#' EXPR
678	  { B1 (0x38); O2 ($3); O1 ($9); }
679
680	| MOV A ',' opt_es EXPR '[' C ']'
681	  { B1 (0x29); O2 ($5); }
682
683	| MOV opt_es EXPR '[' C ']' ',' A
684	  { B1 (0x28); O2 ($3); }
685
686	| MOV opt_es EXPR '[' BC ']' ',' '#' EXPR
687	  { B1 (0x39); O2 ($3); O1 ($9); }
688
689	| MOV opt_es '[' BC ']' ',' '#' EXPR
690	  { B3 (0x39, 0, 0); O1 ($8); }
691
692	| MOV A ',' opt_es EXPR '[' BC ']'
693	  { B1 (0x49); O2 ($5); }
694
695	| MOV A ',' opt_es '[' BC ']'
696	  { B3 (0x49, 0, 0); }
697
698	| MOV opt_es EXPR '[' BC ']' ',' A
699	  { B1 (0x48); O2 ($3); }
700
701	| MOV opt_es '[' BC ']' ',' A
702	  { B3 (0x48, 0, 0); }
703
704	| MOV opt_es '[' SP '+' EXPR ']' ',' '#' EXPR  {NOT_ES}
705	  { B1 (0xc8); O1 ($6); O1 ($10); }
706
707	| MOV opt_es '[' SP ']' ',' '#' EXPR  {NOT_ES}
708	  { B2 (0xc8, 0); O1 ($8); }
709
710	| MOV A ',' opt_es '[' SP '+' EXPR ']'  {NOT_ES}
711	  { B1 (0x88); O1 ($8); }
712
713	| MOV A ',' opt_es '[' SP ']'  {NOT_ES}
714	  { B2 (0x88, 0); }
715
716	| MOV opt_es '[' SP '+' EXPR ']' ',' A  {NOT_ES}
717	  { B1 (0x98); O1 ($6); }
718
719	| MOV opt_es '[' SP ']' ',' A  {NOT_ES}
720	  { B2 (0x98, 0); }
721
722/* ---------------------------------------------------------------------- */
723
724	| mov1 CY ',' EXPR '.' EXPR
725	  { if (expr_is_saddr ($4))
726	      { B2 (0x71, 0x04); FE ($6, 9, 3); SET_SA ($4); O1 ($4); }
727	    else if (expr_is_sfr ($4))
728	      { B2 (0x71, 0x0c); FE ($6, 9, 3); O1 ($4); }
729	    else
730	      NOT_SFR_OR_SADDR;
731	  }
732
733	| mov1 CY ',' A '.' EXPR
734	  { B2 (0x71, 0x8c); FE ($6, 9, 3); }
735
736	| mov1 CY ',' sfr '.' EXPR
737	  { B3 (0x71, 0x0c, $4); FE ($6, 9, 3); }
738
739	| mov1 CY ',' opt_es '[' HL ']' '.' EXPR
740	  { B2 (0x71, 0x84); FE ($9, 9, 3); }
741
742	| mov1 EXPR '.' EXPR ',' CY
743	  { if (expr_is_saddr ($2))
744	      { B2 (0x71, 0x01); FE ($4, 9, 3); SET_SA ($2); O1 ($2); }
745	    else if (expr_is_sfr ($2))
746	      { B2 (0x71, 0x09); FE ($4, 9, 3); O1 ($2); }
747	    else
748	      NOT_SFR_OR_SADDR;
749	  }
750
751	| mov1 A '.' EXPR ',' CY
752	  { B2 (0x71, 0x89); FE ($4, 9, 3); }
753
754	| mov1 sfr '.' EXPR ',' CY
755	  { B3 (0x71, 0x09, $2); FE ($4, 9, 3); }
756
757	| mov1 opt_es '[' HL ']' '.' EXPR ',' CY
758	  { B2 (0x71, 0x81); FE ($7, 9, 3); }
759
760/* ---------------------------------------------------------------------- */
761
762	| MOVS opt_es '[' HL '+' EXPR ']' ',' X
763	  { B2 (0x61, 0xce); O1 ($6); }
764
765/* ---------------------------------------------------------------------- */
766
767	| MOVW AX ',' '#' EXPR
768	  { B1 (0x30); O2 ($5); }
769
770	| MOVW regw_na ',' '#' EXPR
771	  { B1 (0x30); F ($2, 5, 2); O2 ($5); }
772
773	| MOVW opt_es EXPR ',' '#' EXPR {NOT_ES}
774	  { if (expr_is_saddr ($3))
775	      { B1 (0xc9); SET_SA ($3); O1 ($3); O2 ($6); }
776	    else if (expr_is_sfr ($3))
777	      { B1 (0xcb); O1 ($3); O2 ($6); }
778	    else
779	      NOT_SFR_OR_SADDR;
780	  }
781
782	| MOVW AX ',' opt_es EXPR {NOT_ES}
783	  { if (expr_is_saddr ($5))
784	      { B1 (0xad); SET_SA ($5); O1 ($5); WA($5); }
785	    else if (expr_is_sfr ($5))
786	      { B1 (0xae); O1 ($5); WA($5); }
787	    else
788	      NOT_SFR_OR_SADDR;
789	  }
790
791	| MOVW opt_es EXPR ',' AX {NOT_ES}
792	  { if (expr_is_saddr ($3))
793	      { B1 (0xbd); SET_SA ($3); O1 ($3); WA($3); }
794	    else if (expr_is_sfr ($3))
795	      { B1 (0xbe); O1 ($3); WA($3); }
796	    else
797	      NOT_SFR_OR_SADDR;
798	  }
799
800	| MOVW AX ',' regw_na
801	  { B1 (0x11); F ($4, 5, 2); }
802
803	| MOVW regw_na ',' AX
804	  { B1 (0x10); F ($2, 5, 2); }
805
806	| MOVW AX ',' opt_es '!' EXPR
807	  { B1 (0xaf); O2 ($6); WA($6); rl78_linkrelax_addr16 (); }
808
809	| MOVW opt_es '!' EXPR ',' AX
810	  { B1 (0xbf); O2 ($4); WA($4); rl78_linkrelax_addr16 (); }
811
812	| MOVW AX ',' opt_es '[' DE ']'
813	  { B1 (0xa9); }
814
815	| MOVW opt_es '[' DE ']' ',' AX
816	  { B1 (0xb9); }
817
818	| MOVW AX ',' opt_es '[' DE '+' EXPR ']'
819	  { B1 (0xaa); O1 ($8); }
820
821	| MOVW opt_es '[' DE '+' EXPR ']' ',' AX
822	  { B1 (0xba); O1 ($6); }
823
824	| MOVW AX ',' opt_es '[' HL ']'
825	  { B1 (0xab); }
826
827	| MOVW opt_es '[' HL ']' ',' AX
828	  { B1 (0xbb); }
829
830	| MOVW AX ',' opt_es '[' HL '+' EXPR ']'
831	  { B1 (0xac); O1 ($8); }
832
833	| MOVW opt_es '[' HL '+' EXPR ']' ',' AX
834	  { B1 (0xbc); O1 ($6); }
835
836	| MOVW AX ',' opt_es EXPR '[' B ']'
837	  { B1 (0x59); O2 ($5); }
838
839	| MOVW opt_es EXPR '[' B ']' ',' AX
840	  { B1 (0x58); O2 ($3); }
841
842	| MOVW AX ',' opt_es EXPR '[' C ']'
843	  { B1 (0x69); O2 ($5); }
844
845	| MOVW opt_es EXPR '[' C ']' ',' AX
846	  { B1 (0x68); O2 ($3); }
847
848	| MOVW AX ',' opt_es EXPR '[' BC ']'
849	  { B1 (0x79); O2 ($5); }
850
851	| MOVW AX ',' opt_es '[' BC ']'
852	  { B3 (0x79, 0, 0); }
853
854	| MOVW opt_es EXPR '[' BC ']' ',' AX
855	  { B1 (0x78); O2 ($3); }
856
857	| MOVW opt_es '[' BC ']' ',' AX
858	  { B3 (0x78, 0, 0); }
859
860	| MOVW AX ',' opt_es '[' SP '+' EXPR ']' {NOT_ES}
861	  { B1 (0xa8); O1 ($8);  WA($8);}
862
863	| MOVW AX ',' opt_es '[' SP ']' {NOT_ES}
864	  { B2 (0xa8, 0); }
865
866	| MOVW opt_es '[' SP '+' EXPR ']' ',' AX {NOT_ES}
867	  { B1 (0xb8); O1 ($6); WA($6); }
868
869	| MOVW opt_es '[' SP ']' ',' AX {NOT_ES}
870	  { B2 (0xb8, 0); }
871
872	| MOVW regw_na ',' EXPR {SA($4)}
873	  { B1 (0xca); F ($2, 2, 2); SET_SA ($4); O1 ($4); WA($4); }
874
875	| MOVW regw_na ',' opt_es '!' EXPR
876	  { B1 (0xcb); F ($2, 2, 2); O2 ($6); WA($6); rl78_linkrelax_addr16 (); }
877
878	| MOVW SP ',' '#' EXPR
879	  { B2 (0xcb, 0xf8); O2 ($5); }
880
881	| MOVW SP ',' AX
882	  { B2 (0xbe, 0xf8); }
883
884	| MOVW AX ',' SP
885	  { B2 (0xae, 0xf8); }
886
887	| MOVW regw_na ',' SP
888	  { B3 (0xcb, 0xf8, 0xff); F ($2, 2, 2); }
889
890/* ---------------------------------------------------------------------- */
891
892	| NOP
893	  { B1 (0x00); }
894
895/* ---------------------------------------------------------------------- */
896
897	| NOT1 CY
898	  { B2 (0x71, 0xc0); }
899
900/* ---------------------------------------------------------------------- */
901
902	| POP regw
903	  { B1 (0xc0); F ($2, 5, 2); }
904
905	| POP PSW
906	  { B2 (0x61, 0xcd); };
907
908	| PUSH regw
909	  { B1 (0xc1); F ($2, 5, 2); }
910
911	| PUSH PSW
912	  { B2 (0x61, 0xdd); };
913
914/* ---------------------------------------------------------------------- */
915
916	| RET
917	  { B1 (0xd7); }
918
919	| RETI
920	  { B2 (0x61, 0xfc); }
921
922	| RETB
923	  { B2 (0x61, 0xec); }
924
925/* ---------------------------------------------------------------------- */
926
927	| ROL A ',' EXPR
928	  { if (check_expr_is_const ($4, 1, 1))
929	      { B2 (0x61, 0xeb); }
930	  }
931
932	| ROLC A ',' EXPR
933	  { if (check_expr_is_const ($4, 1, 1))
934	      { B2 (0x61, 0xdc); }
935	  }
936
937	| ROLWC AX ',' EXPR
938	  { if (check_expr_is_const ($4, 1, 1))
939	      { B2 (0x61, 0xee); }
940	  }
941
942	| ROLWC BC ',' EXPR
943	  { if (check_expr_is_const ($4, 1, 1))
944	      { B2 (0x61, 0xfe); }
945	  }
946
947	| ROR A ',' EXPR
948	  { if (check_expr_is_const ($4, 1, 1))
949	      { B2 (0x61, 0xdb); }
950	  }
951
952	| RORC A ',' EXPR
953	  { if (check_expr_is_const ($4, 1, 1))
954	      { B2 (0x61, 0xfb);}
955	  }
956
957/* ---------------------------------------------------------------------- */
958
959	| SAR A ',' EXPR
960	  { if (check_expr_is_const ($4, 1, 7))
961	      { B2 (0x31, 0x0b); FE ($4, 9, 3); }
962	  }
963
964	| SARW AX ',' EXPR
965	  { if (check_expr_is_const ($4, 1, 15))
966	      { B2 (0x31, 0x0f); FE ($4, 8, 4); }
967	  }
968
969/* ---------------------------------------------------------------------- */
970
971	| SEL RB0
972	  { B2 (0x61, 0xcf); }
973
974	| SEL RB1
975	  { B2 (0x61, 0xdf); }
976
977	| SEL RB2
978	  { B2 (0x61, 0xef); }
979
980	| SEL RB3
981	  { B2 (0x61, 0xff); }
982
983/* ---------------------------------------------------------------------- */
984
985	| SHL A ',' EXPR
986	  { if (check_expr_is_const ($4, 1, 7))
987	      { B2 (0x31, 0x09); FE ($4, 9, 3); }
988	  }
989
990	| SHL B ',' EXPR
991	  { if (check_expr_is_const ($4, 1, 7))
992	      { B2 (0x31, 0x08); FE ($4, 9, 3); }
993	  }
994
995	| SHL C ',' EXPR
996	  { if (check_expr_is_const ($4, 1, 7))
997	      { B2 (0x31, 0x07); FE ($4, 9, 3); }
998	  }
999
1000	| SHLW AX ',' EXPR
1001	  { if (check_expr_is_const ($4, 1, 15))
1002	      { B2 (0x31, 0x0d); FE ($4, 8, 4); }
1003	  }
1004
1005	| SHLW BC ',' EXPR
1006	  { if (check_expr_is_const ($4, 1, 15))
1007	      { B2 (0x31, 0x0c); FE ($4, 8, 4); }
1008	  }
1009
1010/* ---------------------------------------------------------------------- */
1011
1012	| SHR A ',' EXPR
1013	  { if (check_expr_is_const ($4, 1, 7))
1014	      { B2 (0x31, 0x0a); FE ($4, 9, 3); }
1015	  }
1016
1017	| SHRW AX ',' EXPR
1018	  { if (check_expr_is_const ($4, 1, 15))
1019	      { B2 (0x31, 0x0e); FE ($4, 8, 4); }
1020	  }
1021
1022/* ---------------------------------------------------------------------- */
1023
1024	| SKC
1025	  { B2 (0x61, 0xc8); rl78_relax (RL78_RELAX_BRANCH, 0); }
1026
1027	| SKH
1028	  { B2 (0x61, 0xe3); rl78_relax (RL78_RELAX_BRANCH, 0); }
1029
1030	| SKNC
1031	  { B2 (0x61, 0xd8); rl78_relax (RL78_RELAX_BRANCH, 0); }
1032
1033	| SKNH
1034	  { B2 (0x61, 0xf3); rl78_relax (RL78_RELAX_BRANCH, 0); }
1035
1036	| SKNZ
1037	  { B2 (0x61, 0xf8); rl78_relax (RL78_RELAX_BRANCH, 0); }
1038
1039	| SKZ
1040	  { B2 (0x61, 0xe8); rl78_relax (RL78_RELAX_BRANCH, 0); }
1041
1042/* ---------------------------------------------------------------------- */
1043
1044	| STOP
1045	  { B2 (0x61, 0xfd); }
1046
1047/* ---------------------------------------------------------------------- */
1048
1049	| XCH A ',' regb_na
1050	  { if ($4 == 0) /* X */
1051	      { B1 (0x08); }
1052	    else
1053	      { B2 (0x61, 0x88); F ($4, 13, 3); }
1054	  }
1055
1056	| XCH A ',' opt_es '!' EXPR
1057	  { B2 (0x61, 0xaa); O2 ($6); rl78_linkrelax_addr16 (); }
1058
1059	| XCH A ',' opt_es '[' DE ']'
1060	  { B2 (0x61, 0xae); }
1061
1062	| XCH A ',' opt_es '[' DE '+' EXPR ']'
1063	  { B2 (0x61, 0xaf); O1 ($8); }
1064
1065	| XCH A ',' opt_es '[' HL ']'
1066	  { B2 (0x61, 0xac); }
1067
1068	| XCH A ',' opt_es '[' HL '+' EXPR ']'
1069	  { B2 (0x61, 0xad); O1 ($8); }
1070
1071	| XCH A ',' opt_es '[' HL '+' B ']'
1072	  { B2 (0x61, 0xb9); }
1073
1074	| XCH A ',' opt_es '[' HL '+' C ']'
1075	  { B2 (0x61, 0xa9); }
1076
1077	| XCH A ',' EXPR
1078	  { if (expr_is_sfr ($4))
1079	      { B2 (0x61, 0xab); O1 ($4); }
1080	    else if (expr_is_saddr ($4))
1081	      { B2 (0x61, 0xa8); SET_SA ($4); O1 ($4); }
1082	    else
1083	      NOT_SFR_OR_SADDR;
1084	  }
1085
1086/* ---------------------------------------------------------------------- */
1087
1088	| XCHW AX ',' regw_na
1089	  { B1 (0x31); F ($4, 5, 2); }
1090
1091/* ---------------------------------------------------------------------- */
1092
1093	; /* end of statement */
1094
1095/* ---------------------------------------------------------------------- */
1096
1097opt_es	: /* nothing */
1098	| ES ':'
1099	  { rl78_prefix (0x11); }
1100	;
1101
1102regb	: X { $$ = 0; }
1103	| A { $$ = 1; }
1104	| C { $$ = 2; }
1105	| B { $$ = 3; }
1106	| E { $$ = 4; }
1107	| D { $$ = 5; }
1108	| L { $$ = 6; }
1109	| H { $$ = 7; }
1110	;
1111
1112regb_na	: X { $$ = 0; }
1113	| C { $$ = 2; }
1114	| B { $$ = 3; }
1115	| E { $$ = 4; }
1116	| D { $$ = 5; }
1117	| L { $$ = 6; }
1118	| H { $$ = 7; }
1119	;
1120
1121regw	: AX { $$ = 0; }
1122	| BC { $$ = 1; }
1123	| DE { $$ = 2; }
1124	| HL { $$ = 3; }
1125	;
1126
1127regw_na	: BC { $$ = 1; }
1128	| DE { $$ = 2; }
1129	| HL { $$ = 3; }
1130	;
1131
1132sfr	: SPL { $$ = 0xf8; }
1133	| SPH { $$ = 0xf9; }
1134	| PSW { $$ = 0xfa; }
1135	| CS  { $$ = 0xfc; }
1136	| ES  { $$ = 0xfd; }
1137	| PMC { $$ = 0xfe; }
1138	| MEM { $$ = 0xff; }
1139	;
1140
1141/* ---------------------------------------------------------------------- */
1142/* Shortcuts for groups of opcodes with common encodings.                 */
1143
1144addsub	: ADD  { $$ = 0x00; }
1145	| ADDC { $$ = 0x10; }
1146	| SUB  { $$ = 0x20; }
1147	| SUBC { $$ = 0x30; }
1148	| CMP  { $$ = 0x40; }
1149	| AND_ { $$ = 0x50; }
1150	| OR   { $$ = 0x60; }
1151	| XOR  { $$ = 0x70; }
1152	;
1153
1154addsubw	: ADDW  { $$ = 0x00; }
1155	| SUBW  { $$ = 0x20; }
1156	| CMPW  { $$ = 0x40; }
1157	;
1158
1159andor1	: AND1 { $$ = 0x05; rl78_bit_insn = 1; }
1160	| OR1  { $$ = 0x06; rl78_bit_insn = 1; }
1161	| XOR1 { $$ = 0x07; rl78_bit_insn = 1; }
1162	;
1163
1164bt_bf	: BT { $$ = 0x02;    rl78_bit_insn = 1; rl78_linkrelax_branch (); }
1165	| BF { $$ = 0x04;    rl78_bit_insn = 1; rl78_linkrelax_branch (); }
1166	| BTCLR { $$ = 0x00; rl78_bit_insn = 1; }
1167	;
1168
1169setclr1	: SET1 { $$ = 0; rl78_bit_insn = 1; }
1170	| CLR1 { $$ = 1; rl78_bit_insn = 1; }
1171	;
1172
1173oneclrb	: ONEB { $$ = 0x00; }
1174	| CLRB { $$ = 0x10; }
1175	;
1176
1177oneclrw	: ONEW { $$ = 0x00; }
1178	| CLRW { $$ = 0x10; }
1179	;
1180
1181incdec	: INC { $$ = 0x00; }
1182	| DEC { $$ = 0x10; }
1183	;
1184
1185incdecw	: INCW { $$ = 0x00; }
1186	| DECW { $$ = 0x10; }
1187	;
1188
1189mov1	: MOV1 { rl78_bit_insn = 1; }
1190	;
1191
1192%%
1193/* ====================================================================== */
1194
1195static struct
1196{
1197  const char * string;
1198  int          token;
1199  int          val;
1200}
1201token_table[] =
1202{
1203  { "r0", X, 0 },
1204  { "r1", A, 1 },
1205  { "r2", C, 2 },
1206  { "r3", B, 3 },
1207  { "r4", E, 4 },
1208  { "r5", D, 5 },
1209  { "r6", L, 6 },
1210  { "r7", H, 7 },
1211  { "x", X, 0 },
1212  { "a", A, 1 },
1213  { "c", C, 2 },
1214  { "b", B, 3 },
1215  { "e", E, 4 },
1216  { "d", D, 5 },
1217  { "l", L, 6 },
1218  { "h", H, 7 },
1219
1220  { "rp0", AX, 0 },
1221  { "rp1", BC, 1 },
1222  { "rp2", DE, 2 },
1223  { "rp3", HL, 3 },
1224  { "ax", AX, 0 },
1225  { "bc", BC, 1 },
1226  { "de", DE, 2 },
1227  { "hl", HL, 3 },
1228
1229  { "RB0", RB0, 0 },
1230  { "RB1", RB1, 1 },
1231  { "RB2", RB2, 2 },
1232  { "RB3", RB3, 3 },
1233
1234  { "sp", SP, 0 },
1235  { "cy", CY, 0 },
1236
1237  { "spl", SPL, 0xf8 },
1238  { "sph", SPH, 0xf9 },
1239  { "psw", PSW, 0xfa },
1240  { "cs", CS, 0xfc },
1241  { "es", ES, 0xfd },
1242  { "pmc", PMC, 0xfe },
1243  { "mem", MEM, 0xff },
1244
1245  { ".s", DOT_S, 0 },
1246  { ".b", DOT_B, 0 },
1247  { ".w", DOT_W, 0 },
1248  { ".l", DOT_L, 0 },
1249  { ".a", DOT_A , 0},
1250  { ".ub", DOT_UB, 0 },
1251  { ".uw", DOT_UW , 0},
1252
1253  { "c", FLAG, 0 },
1254  { "z", FLAG, 1 },
1255  { "s", FLAG, 2 },
1256  { "o", FLAG, 3 },
1257  { "i", FLAG, 8 },
1258  { "u", FLAG, 9 },
1259
1260#define OPC(x) { #x, x, IS_OPCODE }
1261
1262  OPC(ADD),
1263  OPC(ADDC),
1264  OPC(ADDW),
1265  { "and", AND_, IS_OPCODE },
1266  OPC(AND1),
1267  OPC(BC),
1268  OPC(BF),
1269  OPC(BH),
1270  OPC(BNC),
1271  OPC(BNH),
1272  OPC(BNZ),
1273  OPC(BR),
1274  OPC(BRK),
1275  OPC(BRK1),
1276  OPC(BT),
1277  OPC(BTCLR),
1278  OPC(BZ),
1279  OPC(CALL),
1280  OPC(CALLT),
1281  OPC(CLR1),
1282  OPC(CLRB),
1283  OPC(CLRW),
1284  OPC(CMP),
1285  OPC(CMP0),
1286  OPC(CMPS),
1287  OPC(CMPW),
1288  OPC(DEC),
1289  OPC(DECW),
1290  OPC(DI),
1291  OPC(DIVHU),
1292  OPC(DIVWU),
1293  OPC(EI),
1294  OPC(HALT),
1295  OPC(INC),
1296  OPC(INCW),
1297  OPC(MACH),
1298  OPC(MACHU),
1299  OPC(MOV),
1300  OPC(MOV1),
1301  OPC(MOVS),
1302  OPC(MOVW),
1303  OPC(MULH),
1304  OPC(MULHU),
1305  OPC(MULU),
1306  OPC(NOP),
1307  OPC(NOT1),
1308  OPC(ONEB),
1309  OPC(ONEW),
1310  OPC(OR),
1311  OPC(OR1),
1312  OPC(POP),
1313  OPC(PUSH),
1314  OPC(RET),
1315  OPC(RETI),
1316  OPC(RETB),
1317  OPC(ROL),
1318  OPC(ROLC),
1319  OPC(ROLWC),
1320  OPC(ROR),
1321  OPC(RORC),
1322  OPC(SAR),
1323  OPC(SARW),
1324  OPC(SEL),
1325  OPC(SET1),
1326  OPC(SHL),
1327  OPC(SHLW),
1328  OPC(SHR),
1329  OPC(SHRW),
1330  OPC(SKC),
1331  OPC(SKH),
1332  OPC(SKNC),
1333  OPC(SKNH),
1334  OPC(SKNZ),
1335  OPC(SKZ),
1336  OPC(STOP),
1337  OPC(SUB),
1338  OPC(SUBC),
1339  OPC(SUBW),
1340  OPC(XCH),
1341  OPC(XCHW),
1342  OPC(XOR),
1343  OPC(XOR1),
1344};
1345
1346#define NUM_TOKENS (sizeof (token_table) / sizeof (token_table[0]))
1347
1348void
1349rl78_lex_init (char * beginning, char * ending)
1350{
1351  rl78_init_start = beginning;
1352  rl78_lex_start = beginning;
1353  rl78_lex_end = ending;
1354  rl78_in_brackets = 0;
1355  rl78_last_token = 0;
1356
1357  rl78_bit_insn = 0;
1358
1359  setbuf (stdout, 0);
1360}
1361
1362/* Return a pointer to the '.' in a bit index expression (like
1363   foo.5), or NULL if none is found.  */
1364static char *
1365find_bit_index (char *tok)
1366{
1367  char *last_dot = NULL;
1368  char *last_digit = NULL;
1369  while (*tok && *tok != ',')
1370    {
1371      if (*tok == '.')
1372	{
1373	  last_dot = tok;
1374	  last_digit = NULL;
1375	}
1376      else if (*tok >= '0' && *tok <= '7'
1377	       && last_dot != NULL
1378	       && last_digit == NULL)
1379	{
1380	  last_digit = tok;
1381	}
1382      else if (ISSPACE (*tok))
1383	{
1384	  /* skip */
1385	}
1386      else
1387	{
1388	  last_dot = NULL;
1389	  last_digit = NULL;
1390	}
1391      tok ++;
1392    }
1393  if (last_dot != NULL
1394      && last_digit != NULL)
1395    return last_dot;
1396  return NULL;
1397}
1398
1399static int
1400rl78_lex (void)
1401{
1402  /*unsigned int ci;*/
1403  char * save_input_pointer;
1404  char * bit = NULL;
1405
1406  while (ISSPACE (*rl78_lex_start)
1407	 && rl78_lex_start != rl78_lex_end)
1408    rl78_lex_start ++;
1409
1410  rl78_last_exp_start = rl78_lex_start;
1411
1412  if (rl78_lex_start == rl78_lex_end)
1413    return 0;
1414
1415  if (ISALPHA (*rl78_lex_start)
1416      || (*rl78_lex_start == '.' && ISALPHA (rl78_lex_start[1])))
1417    {
1418      unsigned int i;
1419      char * e;
1420      char save;
1421
1422      for (e = rl78_lex_start + 1;
1423	   e < rl78_lex_end && ISALNUM (*e);
1424	   e ++)
1425	;
1426      save = *e;
1427      *e = 0;
1428
1429      for (i = 0; i < NUM_TOKENS; i++)
1430	if (strcasecmp (rl78_lex_start, token_table[i].string) == 0
1431	    && !(token_table[i].val == IS_OPCODE && rl78_last_token != 0)
1432	    && !(token_table[i].token == FLAG && !need_flag))
1433	  {
1434	    rl78_lval.regno = token_table[i].val;
1435	    *e = save;
1436	    rl78_lex_start = e;
1437	    rl78_last_token = token_table[i].token;
1438	    return token_table[i].token;
1439	  }
1440      *e = save;
1441    }
1442
1443  if (rl78_last_token == 0)
1444    {
1445      rl78_last_token = UNKNOWN_OPCODE;
1446      return UNKNOWN_OPCODE;
1447    }
1448
1449  if (rl78_last_token == UNKNOWN_OPCODE)
1450    return 0;
1451
1452  if (*rl78_lex_start == '[')
1453    rl78_in_brackets = 1;
1454  if (*rl78_lex_start == ']')
1455    rl78_in_brackets = 0;
1456
1457  /* '.' is funny - the syntax includes it for bitfields, but only for
1458      bitfields.  We check for it specially so we can allow labels
1459      with '.' in them.  */
1460
1461  if (rl78_bit_insn
1462      && *rl78_lex_start == '.'
1463      && find_bit_index (rl78_lex_start) == rl78_lex_start)
1464    {
1465      rl78_last_token = *rl78_lex_start;
1466      return *rl78_lex_start ++;
1467    }
1468
1469  if ((rl78_in_brackets && *rl78_lex_start == '+')
1470      || strchr ("[],#!$:", *rl78_lex_start))
1471    {
1472      rl78_last_token = *rl78_lex_start;
1473      return *rl78_lex_start ++;
1474    }
1475
1476  /* Again, '.' is funny.  Look for '.<digit>' at the end of the line
1477     or before a comma, which is a bitfield, not an expression.  */
1478
1479  if (rl78_bit_insn)
1480    {
1481      bit = find_bit_index (rl78_lex_start);
1482      if (bit)
1483	*bit = 0;
1484      else
1485	bit = NULL;
1486    }
1487
1488  save_input_pointer = input_line_pointer;
1489  input_line_pointer = rl78_lex_start;
1490  rl78_lval.exp.X_md = 0;
1491  expression (&rl78_lval.exp);
1492
1493  if (bit)
1494    *bit = '.';
1495
1496  rl78_lex_start = input_line_pointer;
1497  input_line_pointer = save_input_pointer;
1498  rl78_last_token = EXPR;
1499  return EXPR;
1500}
1501
1502int
1503rl78_error (const char * str)
1504{
1505  int len;
1506
1507  len = rl78_last_exp_start - rl78_init_start;
1508
1509  as_bad ("%s", rl78_init_start);
1510  as_bad ("%*s^ %s", len, "", str);
1511  return 0;
1512}
1513
1514static int
1515expr_is_sfr (expressionS exp)
1516{
1517  unsigned long v;
1518
1519  if (exp.X_op != O_constant)
1520    return 0;
1521
1522  v = exp.X_add_number;
1523  if (0xFFF00 <= v && v <= 0xFFFFF)
1524    return 1;
1525  return 0;
1526}
1527
1528static int
1529expr_is_saddr (expressionS exp)
1530{
1531  unsigned long v;
1532
1533  if (exp.X_op != O_constant)
1534    return 1;
1535
1536  v = exp.X_add_number;
1537  if (0xFFE20 <= v && v <= 0xFFF1F)
1538    return 1;
1539  return 0;
1540}
1541
1542static int
1543expr_is_word_aligned (expressionS exp)
1544{
1545  unsigned long v;
1546
1547  if (exp.X_op != O_constant)
1548    return 1;
1549
1550  v = exp.X_add_number;
1551  if (v & 1)
1552    return 0;
1553  return 1;
1554
1555}
1556
1557static void
1558check_expr_is_bit_index (expressionS exp)
1559{
1560  int val;
1561
1562  if (exp.X_op != O_constant)
1563    {
1564      rl78_error (_("bit index must be a constant"));
1565      return;
1566    }
1567  val = exp.X_add_number;
1568
1569  if (val < 0 || val > 7)
1570    rl78_error (_("rtsd size must be 0..7"));
1571}
1572
1573static int
1574exp_val (expressionS exp)
1575{
1576  if (exp.X_op != O_constant)
1577  {
1578    rl78_error (_("constant expected"));
1579    return 0;
1580  }
1581  return exp.X_add_number;
1582}
1583
1584static int
1585check_expr_is_const (expressionS e, int vmin, int vmax)
1586{
1587  static char buf[100];
1588  if (e.X_op != O_constant
1589      || e.X_add_number < vmin
1590      || e.X_add_number > vmax)
1591    {
1592      if (vmin == vmax)
1593	sprintf (buf, "%d expected here", vmin);
1594      else
1595	sprintf (buf, "%d..%d expected here", vmin, vmax);
1596      rl78_error(buf);
1597      return 0;
1598    }
1599  return 1;
1600}
1601