\ 6309 assembler BASE @ HEX : DEFER CREATE 0 , DOES> @ EXECUTE ; : IS ' >BODY ! ; VOCABULARY ASSEMBLER ASSEMBLER ALSO DEFINITIONS ' C! DEFER VC! IS VC! \ Vectorize the important words so we can cross ' C@ DEFER VC@ IS VC@ \ assemble and self-assemble using the same code. ' ! DEFER V! IS V! ' @ DEFER V@ IS V@ ' C, DEFER C, IS C, ' , DEFER , IS , ' HERE DEFER HERE IS HERE ' ALLOT DEFER ALLOT IS ALLOT VARIABLE VDP : VHERE ( --- addr) VDP @ ; : VALLOT VDP +! ; : VC, ( c --- ) VHERE VC! 1 VALLOT ; : V, ( n ---) VHERE V! 2 VALLOT ; : ORG VDP ! ; : MARK ( --- addr ) HERE 0 C, ; : >RESOLVE ( addr --- ) HERE OVER 1+ - SWAP VC! ; VARIABLE ?MEMIMM \ Memory + immediate (AIM, OIM, EOIM) VARIABLE ?OPCODE VARIABLE OPCODE \ Opcode byte VARIABLE ?POSTBYTE VARIABLE POSTBYTE \ Byte after opcode indicating mode. VARIABLE ?OPERAND \ Address or data after instruction. VARIABLE MODE \ True is direct addressing false is other. VARIABLE DPAGE \ Direct page address. : SETDP ( n ---) \ Set direct page. 100 * DPAGE ! ; 0 SETDP : NOINSTR \ Reset all the instruction flags so there will be no instruction. ?OPCODE OFF ?POSTBYTE OFF ?OPERAND OFF MODE OFF ?MEMIMM OFF ; : A; \ Assemble current instruction and reset instruction flags. MODE @ IF \ direct addresiing? DUP DPAGE @ - 0FF U> IF \ Is address 16 bits? 2 ?OPERAND ! \ Indicate 16 bits address. OPCODE @ 0F0 AND 0= \ Change opcode byte. IF 70 OPCODE +! ELSE 20 OPCODE +! THEN ELSE 1 ?OPERAND ! \ Indicate 8 bis address. THEN THEN ?OPCODE @ IF OPCODE @ DUP 100 > IF DUP 8 RSHIFT C, \ assemble prebyte THEN C, THEN ?MEMIMM @ IF ?OPERAND @ IF SWAP THEN \ move immediate byte from under operand. C, THEN ?POSTBYTE @ IF POSTBYTE @ C, THEN ?OPERAND @ IF CASE ?OPERAND @ 1 OF C, ENDOF \ 8 bits data/address. 2 OF , ENDOF \ 16 bits data/address. 3 OF HERE 1+ - C, ENDOF \ 8 bits relative address. 4 OF HERE 2 + - , ENDOF \ 16 bits relative address. 5 OF , , ENDOF \ 32 bits immediate (LDQ) 6 OF \ single-bit operations. >R \ Save DP address. SWAP 3 LSHIFT OR \ or the bit numbers together. SWAP 6 AND 5 LSHIFT OR \ Add register number. C, \ Store post-byte (reg-srcbit-dstbit) R> C, \ Store direct address. ENDOF \ LDBT etc. ENDCASE THEN NOINSTR ; : LABEL A; HERE CONSTANT ; HEX : # \ Signal immediate mode. MODE OFF -10 OPCODE +! ?OPERAND @ 5 = IF \ Special case is LDQ immediate. 0CD OPCODE ! THEN ; : USE-POSTBYTE \ Signal that postbyte must be used. MODE OFF ?POSTBYTE ON OPCODE @ 0F0 AND 0= IF 60 OPCODE +! ELSE OPCODE @ 80 AND IF 10 OPCODE +! THEN THEN ; : [] \ Signal indirect mode. MODE @ IF \ Indirect addressing with 16-bits addres, no postbyte made yet. USE-POSTBYTE 9F POSTBYTE ! \ Make postbyte. 2 ?OPERAND ! \ Indicate 16-bits address. ELSE POSTBYTE @ 80 AND 0= IF \ 5-bits address format already assembled? POSTBYTE @ 1F AND DUP 10 AND 0<> 0E0 AND OR 1 ?OPERAND ! \ Signal operand. POSTBYTE @ 60 AND 98 OR POSTBYTE ! \ Change postbyte. ELSE POSTBYTE @ 9F AND 8F = IF POSTBYTE @ 1+ POSTBYTE ! \ special case for ,W indexing ELSE POSTBYTE @ 10 OR POSTBYTE ! \ Indicate indirect addressing. THEN THEN THEN ; : ,R \ Modes with a constant offset from a register. CREATE C, DOES> USE-POSTBYTE C@ POSTBYTE ! \ Make register field in postbyte. DUP 0= IF 84 POSTBYTE +! DROP \ Zero offset. ?OPERAND OFF ELSE DUP -10 >= OVER 0F <= AND IF \ 5-bit offset. 1F AND POSTBYTE +! ?OPERAND OFF ELSE DUP 80 + 100 U< IF \ 8-bit offset. 88 POSTBYTE +! 1 ?OPERAND ! ELSE 89 POSTBYTE +! \ 16-bit offset. 2 ?OPERAND ! THEN THEN THEN ; 00 ,R ,X 20 ,R ,Y 40 ,R ,U 60 ,R ,S : ,W \ Addressing with constant offset from W register. USE-POSTBYTE DUP 0= IF 8F POSTBYTE ! DROP \ offset = 0 ?OPERAND OFF ELSE 0AF POSTBYTE ! \ 16-bit offset 2 ?OPERAND ! THEN ; : AMODE \ addressing modes with no operands. CREATE C, DOES> USE-POSTBYTE C@ POSTBYTE ! ?OPERAND OFF ; 080 AMODE ,X+ 081 AMODE ,X++ 082 AMODE ,-X 083 AMODE ,--X 085 AMODE B,X 086 AMODE A,X 08B AMODE D,X 087 AMODE E,X 08A AMODE F,X 08E AMODE W,X 0A0 AMODE ,Y+ 0A1 AMODE ,Y++ 0A2 AMODE ,-Y 0A3 AMODE ,--Y 0A5 AMODE B,Y 0A6 AMODE A,Y 0AB AMODE D,Y 0A7 AMODE E,Y 0AA AMODE F,Y 0AE AMODE W,Y 0C0 AMODE ,U+ 0C1 AMODE ,U++ 0C2 AMODE ,-U 0C3 AMODE ,--U 0C5 AMODE B,U 0C6 AMODE A,U 0CB AMODE D,U 0C7 AMODE E,U 0CA AMODE F,U 0CE AMODE W,U 0E0 AMODE ,S+ 0E1 AMODE ,S++ 0E2 AMODE ,-S 0E3 AMODE ,--S 0E5 AMODE B,S 0E6 AMODE A,S 0EB AMODE D,S 0E7 AMODE E,S 0EA AMODE F,S 0EE AMODE W,S 0CF AMODE ,W++ 0EF AMODE ,--W : ,PCR \ Signal program counter relative. USE-POSTBYTE DUP HERE OPCODE @ 0FF U> - 3 + - \ Subtract address after instruction 80 + 100 U< IF \ 8-bits offset good? 3 ?OPERAND ! 8C POSTBYTE ! ELSE 4 ?OPERAND ! 8D POSTBYTE ! THEN ; : USE-OPCODE ( w ---) ?OPCODE ON OPCODE ! ; : GET-OPCODE ( addr -- )\ >R A; R> @ USE-OPCODE ; : IN1 \ Simple instructions with only opcode, possibly prebyte CREATE , DOES> GET-OPCODE ; 12 IN1 NOP 13 IN1 SYNC 14 IN1 SEXW 19 IN1 DAA 1D IN1 SEX 39 IN1 RTS 3A IN1 ABX 3B IN1 RTI 3D IN1 MUL 1038 IN1 PSHSW 1039 IN1 PULSW 103A IN1 PSHUW 103B IN1 PULUW 3F IN1 SWI 103F IN1 SWI2 113F IN1 SWI3 40 IN1 NEGA 50 IN1 NEGB 43 IN1 COMA 53 IN1 COMB 44 IN1 LSRA 54 IN1 LSRB 46 IN1 RORA 56 IN1 RORB 47 IN1 ASRA 57 IN1 ASRB 48 IN1 ASLA 58 IN1 ASLB 48 IN1 LSLA 58 IN1 LSLB 49 IN1 ROLA 59 IN1 ROLB 4A IN1 DECA 5A IN1 DECB 4C IN1 INCA 5C IN1 INCB 4D IN1 TSTA 5D IN1 TSTB 4F IN1 CLRA 5F IN1 CLRB 1040 IN1 NEGD 1050 IN1 NEGW 1043 IN1 COMD 1051 IN1 COMW 1044 IN1 LSRD 1054 IN1 LSRW 1046 IN1 RORD 1056 IN1 RORW 1047 IN1 ASRD \ what were they smoking when they decided to leave out ASRW/ASLW 1048 IN1 ASLD 1048 IN1 LSRD 1049 IN1 ROLD 1059 IN1 ROLW 104A IN1 DECD 105A IN1 DECW 104C IN1 INCD 105C IN1 INCW 104D IN1 TSTD 105D IN1 TSTW 104F IN1 CLRD 105F IN1 CLRW 1143 IN1 COME 1153 IN1 COMF 114A IN1 DECE 115A IN1 DECF 114C IN1 INCE 115C IN1 INCF 114D IN1 TSTE 115D IN1 TSTF 114F IN1 CLRE 115F IN1 CLRF \ Though not no-operand instructions the LEA instructions \ are treated correctly as the postbyte is added by the mode words. 30 IN1 LEAX 31 IN1 LEAY 32 IN1 LEAS 33 IN1 LEAU : BR-8 \ relative branches with 8-bit offset CREATE , DOES> GET-OPCODE 3 ?OPERAND ! ; 20 BR-8 BRA 21 BR-8 BRN 22 BR-8 BHI 23 BR-8 BLS 24 BR-8 BCC 25 BR-8 BCS 24 BR-8 BHS 25 BR-8 BLO 26 BR-8 BNE 27 BR-8 BEQ 28 BR-8 BVC 29 BR-8 BVS 2A BR-8 BPL 2B BR-8 BMI 2C BR-8 BGE 2D BR-8 BLT 2E BR-8 BGT 2F BR-8 BLE 8D BR-8 BSR : LBRA A; 16 USE-OPCODE 4 ?OPERAND ! ; : LBSR A; 17 USE-OPCODE 4 ?OPERAND ! ; : BR16 \ Relative branches with 16-bit offset. CREATE , DOES> GET-OPCODE 4 ?OPERAND ! ; 1021 BR16 LBRN 1022 BR16 LBHI 1023 BR16 LBLS 1024 BR16 LBCC 1025 BR16 LBCS 1024 BR16 LBHS 1025 BR16 LBLO 1026 BR16 LBNE 1027 BR16 LBEQ 1028 BR16 LBVC 1029 BR16 LBVS 102A BR16 LBPL 102B BR16 LBMI 102C BR16 LBGE 102D BR16 LBLT 102E BR16 LBGT 102F BR16 LBLE : IN2 \ Instructions with one immediate data byte. CREATE , DOES> GET-OPCODE 1 ?OPERAND ! ; 1A IN2 ORCC 1C IN2 ANDCC 3C IN2 CWAI 113C IN2 BITMD 113D IN2 LDMD : % ( --- n) \ Interpret next word as a binary number. BASE @ 2 BASE ! BL WORD NUMBER? drop DROP SWAP BASE ! ; : REG \ Registers as used in PUSH PULL TFR and EXG instructions. CREATE C, C, DOES> ?OPERAND @ IF \ Is a PUSH/PULL instruction meant? 1+ C@ OR ELSE C@ POSTBYTE +! \ It's a TFR,EXG instruction. THEN ; 06 00 REG D, 06 00 REG D 10 10 REG X, 10 01 REG X 20 20 REG Y, 20 02 REG Y 40 30 REG U, 40 03 REG U 40 40 REG S, 40 04 REG S 80 50 REG PC, 80 05 REG PC 00 60 REG W, 00 06 REG W 00 70 REG V, 00 07 REG V 02 80 REG A, 02 08 REG A 04 90 REG B, 04 09 REG B 01 A0 REG CC, 01 0A REG CC 08 B0 REG DP, 08 0B REG DP 00 C0 REG Z, 08 0C REG Z \ Zero register. 00 E0 REG E, 00 0E REG E 00 F0 REG F, 00 0F REG F : R2R \ Reg to reg instructions CREATE , DOES> GET-OPCODE ?POSTBYTE ON 0 POSTBYTE ! ; 1E R2R EXG 1F R2R TFR 1030 R2R ADDR 1031 R2R ADCR 1032 R2R SUBR 1033 R2R SBCR 1034 R2R ANDR 1035 R2R ORR 1036 R2R EORR 1037 R2R CMPR 1138 R2R TFM++ \ TFM++ X, Y for tfm x+,y+ 1139 R2R TFM-- \ TFM-- X, Y for tfm x-,y- 113A R2R TFM+0 \ TFM+0 X, Y for tfm x+,y 113B R2R TFM0+ \ TFM0+ X, Y for tfm x,y+ : STK \ Stack instructions. CREATE , DOES> GET-OPCODE 1 ?OPERAND ! 0 ; 34 STK PSHS 35 STK PULS 36 STK PSHU 37 STK PULU : OP-8 \ Instructions with 8-bits data. CREATE , DOES> GET-OPCODE MODE ON 1 ?OPERAND ! ; 00 OP-8 NEG 03 OP-8 COM 04 OP-8 LSR 06 OP-8 ROR 07 OP-8 ASR 08 OP-8 ASL 08 OP-8 LSL 09 OP-8 ROL 0A OP-8 DEC 0C OP-8 INC 0D OP-8 TST 0E OP-8 JMP 0F OP-8 CLR 90 OP-8 SUBA 0D0 OP-8 SUBB 91 OP-8 CMPA 0D1 OP-8 CMPB 92 OP-8 SBCA 0D2 OP-8 SBCB 94 OP-8 ANDA 0D4 OP-8 ANDB 95 OP-8 BITA 0D5 OP-8 BITB 96 OP-8 LDA 0D6 OP-8 LDB 97 OP-8 STA 0D7 OP-8 STB 98 OP-8 EORA 0D8 OP-8 EORB 99 OP-8 ADCA 0D9 OP-8 ADCB 9A OP-8 ORA 0DA OP-8 ORB 9B OP-8 ADDA 0DB OP-8 ADDB 9D OP-8 JSR 1190 OP-8 SUBE 11D0 OP-8 SUBF 1191 OP-8 CMPE 11D1 OP-8 CMPF 1196 OP-8 LDE 11D6 OP-8 LDF 1197 OP-8 STE 11D7 OP-8 STF 119B OP-8 ADDE 11DB OP-8 ADDF 119D OP-8 DIVD : OP16 \ Instructions with 16-bits daia. CREATE , DOES> GET-OPCODE MODE ON 2 ?OPERAND ! ; 93 OP16 SUBD 0D3 OP16 ADDD 9C OP16 CMPX 0DC OP16 LDD 0DD OP16 STD 9E OP16 LDX 0DE OP16 LDU 9F OP16 STX 0DF OP16 STU 1090 OP16 SUBW 1091 OP16 CMPW 1092 OP16 SBCD 1093 OP16 CMPD 1094 OP16 ANDD 1095 OP16 BITD 1096 OP16 LDW 1097 OP16 STW 1098 OP16 EORD 1099 OP16 ADCD 109A OP16 ORD 109B OP16 ADDW 109C OP16 CMPY 109E OP16 LDY 109F OP16 STY 10DE OP16 LDS 10DF OP16 STS 1193 OP16 CMPU 119C OP16 CMPS 119E OP16 DIVQ 119F OP16 MULD : OP32 \ Instructions with 32-bits daia. CREATE , DOES> GET-OPCODE MODE ON 5 ?OPERAND ! ; 10DC OP32 LDQ 10DD OP32 STQ : OP-MEMIMM \ Instructions with memory addressing and 8-bit immediate CREATE , DOES> GET-OPCODE MODE ON ?MEMIMM ON 1 ?OPERAND ! ; 01 OP-MEMIMM OIM 02 OP-MEMIMM AIM 05 OP-MEMIMM EIM 0B OP-MEMIMM TIM : OP-BIT \ Instructions for single bit in A,B,CC register and direct page. CREATE , DOES> GET-OPCODE 6 ?OPERAND ! 0 ; 1130 OP-BIT BAND 1131 OP-BIT BIAND 1132 OP-BIT BOR 1133 OP-BIT BIOR 1134 OP-BIT BEOR 1135 OP-BIT BIEOR 1136 OP-BIT LDBT 1137 OP-BIT STBT \ Structured assembler constructs. : IF >R A; R> C, >MARK ; : THEN A; >RESOLVE ; : ELSE A; 20 C, >MARK SWAP >RESOLVE ; : BEGIN A; R A; R> C, R A; R> C, >MARK ; : REPEAT A; 20 C, SWAP RESOLVE ; : AGAIN 20 UNTIL ; 22 CONSTANT U<= 23 CONSTANT U> 24 CONSTANT U< 25 CONSTANT U>= 26 CONSTANT 0= 27 CONSTANT 0<> 28 CONSTANT VS 29 CONSTANT VC 2A CONSTANT 0< 2B CONSTANT 0>= 2C CONSTANT < 2D CONSTANT >= 2E CONSTANT <= 2F CONSTANT > : ENDASM \ End assembly. A; PREVIOUS ; FORTH DEFINITIONS : ASSEMBLE \ Start assembly. ALSO ASSEMBLER NOINSTR ; : CODE CREATE -3 ALLOT ASSEMBLE ; : END-CODE [ ASSEMBLER ] ENDASM [ FORTH ] ; PREVIOUS FORTH DEFINITIONS BASE ! \ Restore the original base.