urflibs/urasm/opc/alu.f

   1 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;; and now for something completely different...
   3 ;; UrAsm Forth Engine!
   4 ;; GPLv3 ONLY
   5 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   6 ;; Z80 Assembler: ALU instructions
   7 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   8
   9
  10 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  11 ;; ALU helpers
  12 ;; lexer is at the first operand
  13 ;;
  14
  15 also asm-resw
  16 also-defs: asm-helpers
  17
  18 0 value alu-opcode
  19
  20
  21 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  22 ;; ALU r8
  23 ;;
  24
  25 \ ALU [A,] r8
  26 : (alu-a-r8)  ( -- )
  27   alu-opcode tok-kind or asm-emit:byte
  28   next-token
  29 ;
  30
  31 \ ALU [A,] imm8
  32 : (alu-a-imm8)  ( alu-code -- )
  33   alu-opcode 0o306 or asm-emit:byte
  34   asm-expr:expression-byte,
  35 ;
  36
  37 \ ALU [A,] <x|y><l|h>
  38 : (alu-a-xylh)  ( -- )
  39   tok-kind 2 and (ixy-prefix,)
  40   tok-kind 1 and kind-h + alu-opcode or asm-emit:byte
  41   next-token
  42 ;
  43
  44 \ ALU [A,] (i<xy>+...)
  45 : (alu-a-(ixy))  ( -- )
  46   kind-(hl) alu-opcode or (common-ixy) drop
  47 ;
  48
  49 dispatcher: (dsp-alu-r8)
  50   dsp: token-r8?     (alu-a-r8)
  51   dsp: token-(ixy)?  (alu-a-(ixy))
  52   dsp: token-rx8?    (alu-a-xylh)
  53   dsp: true          (alu-a-imm8)
  54 end-dispatcher
  55
  56 : (alu-r8-common)  ( alu-code -- )
  57   to alu-opcode
  58   ;; skip "A,", it is optional
  59   token-regA? if
  60     next-token token-comma? ifnot  ;; alu A,something
  61       kind-a alu-opcode or asm-emit:byte
  62       next-token exit
  63     endif
  64     expect-comma
  65   endif
  66   (dsp-alu-r8)
  67 ;
  68
  69 : (alu-r8-common-drop)  ( alu-code pfx<<8+opcode -- )  drop (alu-r8-common) ;
  70
  71
  72 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  73 ;; ALU r16
  74 ;;
  75
  76 : (alu-lhx-r16-common)  ( alu-code pfx<<8+opcode -- )  nip
  77   dup -8 lsh ?dup if asm-emit:byte endif
  78   next-token expect-comma
  79 ;
  80
  81 : (alu-r16-finish)  ( pfx<<8+opcode -- )
  82   expect-r16
  83   dup kind-sp > " invalid instruction" ?error
  84   4 lsh or asm-emit:byte
  85 ;
  86
  87 \ ALU HL,r16
  88 : (alu-hl-r16)  ( alu-code pfx<<8+opcode -- )
  89   (alu-lhx-r16-common) (alu-r16-finish)
  90 ;
  91
  92 : (alu-ixy-r16) ( alu-code pfx<<8+opcode -- )
  93   dup 0xff > " invalid instruction" ?error
  94   tok-kind dup >r
  95   1 and (ixy-prefix,) (alu-lhx-r16-common)
  96   token-ixy? if
  97     r> tok-kind <> " invalid instruction" ?error
  98     kind-hl 4 lsh or asm-emit:byte
  99     next-token
 100   else rdrop (alu-r16-finish)
 101   endif
 102 ;
 103
 104 dispatcher: (dsp-adcx)  ( simple-opcode pfx<<8+opcode -- )
 105   dsp: token-hl?  (alu-hl-r16)
 106   dsp: token-ixy? (alu-ixy-r16)
 107   dsp: true       (alu-r8-common-drop)
 108 end-dispatcher
 109
 110 previous prev-defs
 111
 112
 113 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 114 ;; LD main
 115 ;;
 116
 117 also-defs: asm-instr
 118
 119 : ADD  ( -- )  next-token 0o200 0o011 asm-helpers:(dsp-adcx) ;
 120 : ADC  ( -- )  next-token 0o210 [ 0xed00 0o112 or ] imm-literal asm-helpers:(dsp-adcx) ;
 121 : SUB  ( -- )  next-token 0o220 asm-helpers:(alu-r8-common) ;
 122 : SBC  ( -- )  next-token 0o230 [ 0xed00 0o102 or ] imm-literal asm-helpers:(dsp-adcx) ;
 123 : AND  ( -- )  next-token 0o240 asm-helpers:(alu-r8-common) ;
 124 : XOR  ( -- )  next-token 0o250 asm-helpers:(alu-r8-common) ;
 125 : OR   ( -- )  next-token 0o260 asm-helpers:(alu-r8-common) ;
 126 : CP   ( -- )  next-token 0o270 asm-helpers:(alu-r8-common) ;
 127
 128 prev-defs