Mercurial > hg > Members > kono > os9 > sbc09

comparison examples_forth/asm09.4 @ 57:2088fd998865

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
sbc09 directry clean up
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Mon, 23 Jul 2018 16:07:12 +0900
parents
children
comparison
equal deleted inserted replaced
56:4fa2bdb0c457 57:2088fd998865
1 \ 6809 assembler
2
3 BASE @ HEX
4
5 : DEFER CREATE 0 , DOES> @ EXECUTE ;
6 : IS ' >BODY ! ;
7
8 VOCABULARY ASSEMBLER
9 ASSEMBLER ALSO DEFINITIONS
10
11 ' C! DEFER VC! IS VC! \ Vectorize the important words so we can cross
12 ' C@ DEFER VC@ IS VC@ \ assemble and self-assemble using the same code.
13 ' ! DEFER V! IS V!
14 ' @ DEFER V@ IS V@
15 ' C, DEFER C, IS C,
16 ' , DEFER , IS ,
17 ' HERE DEFER HERE IS HERE
18 ' ALLOT DEFER ALLOT IS ALLOT
19
20 VARIABLE VDP
21 : VHERE ( --- addr)
22 VDP @ ;
23 : VALLOT VDP +! ;
24 : VC, ( c --- )
25 VHERE VC! 1 VALLOT ;
26 : V, ( n ---)
27 VHERE V! 2 VALLOT ;
28 : ORG VDP ! ;
29
30 : <MARK ( --- addr )
31 HERE ;
32 : <RESOLVE ( addr ---)
33 HERE 1+ - C, ;
34 : >MARK ( --- addr )
35 HERE 0 C, ;
36 : >RESOLVE ( addr --- )
37 HERE OVER 1+ - SWAP VC! ;
38
39 VARIABLE ?PREBYTE VARIABLE PREBYTE \ Byte $10 or $11 before opcode
40 VARIABLE ?OPCODE VARIABLE OPCODE \ Opcode byte
41 VARIABLE ?POSTBYTE VARIABLE POSTBYTE \ Byte after opcode indicating mode.
42 VARIABLE ?OPERAND \ Address or data after instruction.
43 VARIABLE MODE \ True is direct addressing false is other.
44 VARIABLE DPAGE \ Direct page address.
45 : SETDP ( n ---) \ Set direct page.
46 100 * DPAGE ! ;
47 0 SETDP
48
49 : NOINSTR \ Reset all the instruction flags so there will be no instruction.
50 ?PREBYTE OFF ?OPCODE OFF ?POSTBYTE OFF ?OPERAND OFF MODE OFF ;
51 : A; \ Assemble current instruction and reset instruction flags.
52 MODE @ IF \ direct addresiing?
53 DUP DPAGE @ - 0FF U> IF \ Is address 16 bits?
54 2 ?OPERAND ! \ Indicate 16 bits address.
55 OPCODE @ 0F0 AND 0= \ Change opcode byte.
56 IF 70 OPCODE +!
57 ELSE 20 OPCODE +!
58 THEN
59 ELSE 1 ?OPERAND ! \ Indicate 8 bis address.
60 THEN
61 THEN
62 ?PREBYTE @ IF PREBYTE @ C, THEN
63 ?OPCODE @ IF OPCODE @ C, THEN
64 ?POSTBYTE @ IF POSTBYTE @ C, THEN
65 ?OPERAND @ IF
66 CASE ?OPERAND @
67 1 OF C, ENDOF \ 8 bits data/address.
68 2 OF , ENDOF \ 16 bits data/address.
69 3 OF HERE 1+ - C, ENDOF \ 8 bits relative address.
70 4 OF HERE 2 + - , ENDOF \ 16 bits realtive address.
71 ENDCASE
72 THEN NOINSTR ;
73
74
75 : LABEL A; HERE CONSTANT ;
76
77
78 HEX
79 : flag10 \ Indicate that next instruction has prebyte $10
80 ?PREBYTE ON 10 PREBYTE ! ;
81 : flag11 \ Indicate that next instruction has prebyte $11
82 ?PREBYTE ON 11 PREBYTE ! ;
83
84 : # \ Signal immediate mode.
85 MODE OFF -10 OPCODE +! ;
86
87 : USE-POSTBYTE \ Signal that postbyte must be used.
88 MODE OFF
89 ?POSTBYTE ON
90 OPCODE @ 0F0 AND 0= IF
91 60 OPCODE +!
92 ELSE
93 OPCODE @ 80 AND IF
94 10 OPCODE +!
95 THEN
96 THEN ;
97
98 : [] \ Signal indirect mode.
99 MODE @ IF \ Indirect addressing with 16-bits addres, no postbyte made yet.
100 USE-POSTBYTE
101 9F POSTBYTE ! \ Make postbyte.
102 2 ?OPERAND ! \ Indicate 16-bits address.
103 ELSE
104 POSTBYTE @ 80 AND 0= IF \ 5-bits address format already assembled?
105 POSTBYTE @ 1F AND DUP 10 AND 0<> 0E0 AND OR
106 1 ?OPERAND ! \ Signal operand.
107 POSTBYTE @ 60 AND 98 OR POSTBYTE ! \ Change postbyte.
108 ELSE
109 POSTBYTE @ 10 OR POSTBYTE ! \ Indicate indirect addressing.
110 THEN
111 THEN ;
112
113 : ,R \ Modes with a constant offset from a register.
114 CREATE C,
115 DOES> USE-POSTBYTE
116 C@ POSTBYTE ! \ Make register field in postbyte.
117 DUP 0= IF
118 84 POSTBYTE +! DROP \ Zero offset.
119 ?OPERAND OFF
120 ELSE
121 DUP -10 >= OVER 0F <= AND IF \ 5-bit offset.
122 1F AND POSTBYTE +!
123 ?OPERAND OFF
124 ELSE
125 DUP 80 + 100 U< IF \ 8-bit offset.
126 88 POSTBYTE +!
127 1 ?OPERAND !
128 ELSE
129 89 POSTBYTE +! \ 16-bit offset.
130 2 ?OPERAND !
131 THEN
132 THEN
133 THEN ;
134 00 ,R ,X
135 20 ,R ,Y
136 40 ,R ,U
137 60 ,R ,S
138
139 : AMODE \ addressing modes with no operands.
140 CREATE C,
141 DOES> USE-POSTBYTE
142 C@ POSTBYTE !
143 ?OPERAND OFF ;
144 080 AMODE ,X+ 081 AMODE ,X++ 082 AMODE ,-X 083 AMODE ,--X
145 085 AMODE B,X 086 AMODE A,X 08B AMODE D,X
146 0A0 AMODE ,Y+ 0A1 AMODE ,Y++ 0A2 AMODE ,-Y 0A3 AMODE ,--Y
147 0A5 AMODE B,Y 0A6 AMODE A,Y 0AB AMODE D,Y
148 0C0 AMODE ,U+ 0C1 AMODE ,U++ 0C2 AMODE ,-U 0C3 AMODE ,--U
149 0C5 AMODE B,U 0C6 AMODE A,U 0CB AMODE D,U
150 0E0 AMODE ,S+ 0E1 AMODE ,S++ 0E2 AMODE ,-S 0E3 AMODE ,--S
151 0E5 AMODE B,S 0E6 AMODE A,S 0EB AMODE D,S
152
153 : ,PCR \ Signal program counter relative.
154 USE-POSTBYTE
155 DUP
156 HERE ?PREBYTE @ - 3 + - \ Subtract address after instruction
157 80 + 100 U< IF \ 8-bits offset good?
158 3 ?OPERAND !
159 8C POSTBYTE !
160 ELSE
161 4 ?OPERAND !
162 8D POSTBYTE !
163 THEN ;
164
165 : USE-OPCODE ( c ---)
166 ?OPCODE ON
167 OPCODE ! ;
168
169 : IN1 \ Simple instructions with one byte opcode
170 CREATE C,
171 DOES> >R A; R> C@ USE-OPCODE ;
172 12 IN1 NOP 13 IN1 SYNC
173 19 IN1 DAA 1D IN1 SEX
174 39 IN1 RTS 3A IN1 ABX
175 3B IN1 RTI 3D IN1 MUL
176 3F IN1 SWI : SWI2 SWI flag10 ; : SWI3 SWI flag11 ;
177 40 IN1 NEGA 50 IN1 NEGB
178 43 IN1 COMA 53 IN1 COMB
179 44 IN1 LSRA 54 IN1 LSRB
180 46 IN1 RORA 56 IN1 RORB
181 47 IN1 ASRA 57 IN1 ASRB
182 48 IN1 ASLA 58 IN1 ASLB
183 48 IN1 LSLA 58 IN1 LSLB
184 49 IN1 ROLA 59 IN1 ROLB
185 4A IN1 DECA 5A IN1 DECB
186 4C IN1 INCA 5C IN1 INCB
187 4D IN1 TSTA 5D IN1 TSTB
188 4F IN1 CLRA 5F IN1 CLRB
189 \ Though not no-operand instructions the LEA instructions
190 \ are treated correctly as the postbyte is added by the mode words.
191 30 IN1 LEAX 31 IN1 LEAY
192 32 IN1 LEAS 33 IN1 LEAU
193 : DEX LEAX -1 ,X ; : INX LEAX 1 ,X ;
194 : DES LEAS -1 ,S ; : INS LEAS 1 ,S ;
195 : DEY LEAY -1 ,Y ; : INY LEAY 1 ,Y ;
196
197 : BR-8 \ relative branches with 8-bit offset
198 CREATE C,
199 DOES> >R A; R> C@ USE-OPCODE 3 ?OPERAND ! ;
200 20 BR-8 BRA 21 BR-8 BRN
201 22 BR-8 BHI 23 BR-8 BLS
202 24 BR-8 BCC 25 BR-8 BCS
203 24 BR-8 BHS 25 BR-8 BLO
204 26 BR-8 BNE 27 BR-8 BEQ
205 28 BR-8 BVC 29 BR-8 BVS
206 2A BR-8 BPL 2B BR-8 BMI
207 2C BR-8 BGE 2D BR-8 BLT
208 2E BR-8 BGT 2F BR-8 BLE
209 8D BR-8 BSR
210
211 : LBRA
212 A; 16 USE-OPCODE 4 ?OPERAND ! ;
213 : LBSR
214 A; 17 USE-OPCODE 4 ?OPERAND ! ;
215
216 : BR16 \ Relative branches with 16-bit offset.
217 CREATE C,
218 DOES> >R A; R> C@ USE-OPCODE flag10 4 ?OPERAND ! ;
219 21 BR16 LBRN
220 22 BR16 LBHI 23 BR16 LBLS
221 24 BR16 LBCC 25 BR16 LBCS
222 24 BR16 LBHS 25 BR16 LBLO
223 26 BR16 LBNE 27 BR16 LBEQ
224 28 BR16 LBVC 29 BR16 LBVS
225 2A BR16 LBPL 2B BR16 LBMI
226 2C BR16 LBGE 2D BR16 LBLT
227 2E BR16 LBGT 2F BR16 LBLE
228
229 : IN2 \ Instructions with one immediate data byte.
230 CREATE C,
231 DOES> >R A; R> C@ USE-OPCODE 1 ?OPERAND ! ;
232 1A IN2 ORCC 1C IN2 ANDCC 3C IN2 CWAI
233 : CLC ANDCC 0FE ; : SEC ORCC 01 ;
234 : CLF ANDCC 0BF ; : SEF ORCC 40 ;
235 : CLI ANDCC 0EF ; : SEI ORCC 10 ;
236 : CLIF ANDCC 0AF ; : SEIF ORCC 50 ;
237 : CLV ANDCC 0FD ; : SEV ORCC 02 ;
238 : % ( --- n) \ Interpret next word as a binary number.
239 BASE @ 2 BASE ! BL WORD NUMBER? drop DROP SWAP BASE ! ;
240
241 : REG \ Registers as used in PUSH PULL TFR and EXG instructions.
242 CREATE C, C,
243 DOES> ?OPERAND @ IF \ Is a PUSH/PULL instruction meant?
244 1+ C@ OR
245 ELSE
246 C@ POSTBYTE +! \ It's a TFR,EXG instruction.
247 THEN ;
248 06 00 REG D, 06 00 REG D
249 10 10 REG X, 10 01 REG X
250 20 20 REG Y, 20 02 REG Y
251 40 30 REG U, 40 03 REG U
252 40 40 REG S, 40 04 REG S
253 80 50 REG PC, 80 05 REG PC
254 02 80 REG A, 02 08 REG A
255 04 90 REG B, 04 09 REG B
256 01 A0 REG CC, 01 0A REG CC
257 08 B0 REG DP, 08 0B REG DP
258
259 : EXG A; 1E USE-OPCODE ?POSTBYTE ON 0 POSTBYTE ! ;
260 : TFR A; 1F USE-OPCODE ?POSTBYTE ON 0 POSTBYTE ! ;
261 : STK \ Stack instructions.
262 CREATE C,
263 DOES> >R A; R> C@ USE-OPCODE
264 1 ?OPERAND ! 0 ;
265 34 STK PSHS 35 STK PULS
266 36 STK PSHU 37 STK PULU
267
268 : OP-8 \ Instructions with 8-bits data.
269 CREATE C,
270 DOES> >R A; R> C@ USE-OPCODE
271 MODE ON
272 1 ?OPERAND ! ;
273 00 OP-8 NEG 03 OP-8 COM
274 04 OP-8 LSR 06 OP-8 ROR
275 07 OP-8 ASR 08 OP-8 ASL
276 08 OP-8 LSL 09 OP-8 ROL
277 0A OP-8 DEC 0C OP-8 INC
278 0D OP-8 TST 0E OP-8 JMP
279 0F OP-8 CLR
280 90 OP-8 SUBA 0D0 OP-8 SUBB
281 91 OP-8 CMPA 0D1 OP-8 CMPB
282 92 OP-8 SBCA 0D2 OP-8 SBCB
283 94 OP-8 ANDA 0D4 OP-8 ANDB
284 95 OP-8 BITA 0D5 OP-8 BITB
285 96 OP-8 LDA 0D6 OP-8 LDB
286 97 OP-8 STA 0D7 OP-8 STB
287 98 OP-8 EORA 0D8 OP-8 EORB
288 99 OP-8 ADCA 0D9 OP-8 ADCB
289 9A OP-8 ORA 0DA OP-8 ORB
290 9B OP-8 ADDA 0DB OP-8 ADDB
291 9D OP-8 JSR
292
293 : OP16 \ Instructions with 16-bits daia.
294 CREATE C,
295 DOES> >R A; R> C@ USE-OPCODE
296 MODE ON
297 2 ?OPERAND ! ;
298 93 OP16 SUBD 0D3 OP16 ADDD
299 9C OP16 CMPX 0DC OP16 LDD 0DD OP16 STD
300 9E OP16 LDX 0DE OP16 LDU
301 9F OP16 STX 0DF OP16 STU
302 : CMPD SUBD flag10 ; : CMPY CMPX flag10 ;
303 : LDY LDX flag10 ; : STY STX flag10 ;
304 : LDS LDU flag10 ; : STS STU flag10 ;
305 : CMPU SUBD flag11 ; : CMPS CMPX flag11 ;
306
307 \ Structured assembler constructs.
308 : IF >R A; R> C, >MARK ;
309 : THEN A; >RESOLVE ;
310 : ELSE A; 20 C, >MARK SWAP >RESOLVE ;
311 : BEGIN A; <MARK ;
312 : UNTIL >R A; R> C, <RESOLVE ;
313 : WHILE >R A; R> C, >MARK ;
314 : REPEAT A; 20 C, SWAP <RESOLVE >RESOLVE ;
315 : AGAIN 20 UNTIL ;
316 22 CONSTANT U<= 23 CONSTANT U>
317 24 CONSTANT U< 25 CONSTANT U>=
318 26 CONSTANT 0= 27 CONSTANT 0<>
319 28 CONSTANT VS 29 CONSTANT VC
320 2A CONSTANT 0< 2B CONSTANT 0>=
321 2C CONSTANT < 2D CONSTANT >=
322 2E CONSTANT <= 2F CONSTANT >
323
324 : ENDASM \ End assembly.
325 A; PREVIOUS ;
326 FORTH DEFINITIONS
327 : ASSEMBLE \ Start assembly.
328 ALSO ASSEMBLER NOINSTR ;
329
330 : CODE CREATE -3 ALLOT ASSEMBLE ;
331 : END-CODE [ ASSEMBLER ] ENDASM [ FORTH ] ;
332
333 PREVIOUS FORTH DEFINITIONS
334
335 BASE ! \ Restore the original base.