ref: 7c76dac1b268038f567939a70a18228e790a5cbc
dir: /test/asm68k.4th/
HEX
4e71 constant nop
\ w, ( WORD compile )
: w, ( d16 -- ) dup 100 / c, c, ;
: OCTAL 8 BASE ! ;
\ FORTH ASSEMBLER ....
ALSO FORTH
VOCABULARY ASSEMBLER IMMEDIATE
ASSEMBLER DEFINITIONS
: END-CODE ALIGN CURRENT @ CONTEXT ! ;
: *SWAP SWAP ;
: ?, IF w, THEN w, ;
\ SIZES
OCTAL
VARIABLE SIZE
: BYTE 10000 SIZE ! ;
: WORD 30100 SIZE ! ;
: LONG 24600 SIZE ! ;
: SZ CREATE , DOES> @ SIZE @ AND OR ;
00300 SZ SZ3
00400 SZ SZ4
04000 SZ SZ40
30000 SZ SZ300
: LONG? SIZE @ 24600 = ;
: -SZ1 LONG? IF 100 OR THEN ;
\ ADDRESSING MODES
: REGS 10 0 DO DUP 1001 I * OR CONSTANT LOOP DROP ;
: MODE CREATE , DOES> @ SWAP 7007 AND OR ;
0000 REGS D0 D1 D2 D3 D4 D5 D6 D7
0110 REGS A0 A1 A2 A3 A4 A5 A6 A7
0220 MODE )
0330 MODE )+
0440 MODE -)
0550 MODE D)
0660 MODE DI)
0770 CONSTANT #)
1771 CONSTANT L#)
2772 CONSTANT PCD)
3773 CONSTANT PCDI)
4774 CONSTANT #
\ FIELDS AND REGISTER ASSIGNMENTS
: FIELD CREATE , DOES> @ AND ;
7000 FIELD RD
0007 FIELD RS
0070 FIELD MS
0077 FIELD EAS
0377 FIELD LOW
: DN? DUP MS 0 = ;
: SRC OVER EAS OR ;
: DST SWAP RD OR ;
A7 CONSTANT SP
A6 CONSTANT RP
A5 CONSTANT IP
: ?MODE 0 = ABORT" BAD MODE" ;
: ??Dn DN? ?MODE ;
: ??An DUP MS 1 = ?MODE ;
: ??JMP DUP MS DUP 2 = SWAP 4 > OR OVER 74 = NOT AND ?MODE ;
\ EXTENDED ADDRESSING
: DOUBLE? DUP L#) = SWAP # = LONG? AND OR ;
: INDEX?
DUP >R DUP 0770 AND A0 DI) = SWAP PCDI) = OR
IF DUP RD 10 * SWAP MS IF 100000 OR THEN
SZ40 SWAP LOW OR
THEN R> ;
: MORE? DUP MS 0040 > ;
: ,MORE MORE? IF INDEX? DOUBLE? ?, ELSE DROP THEN ;
\ EXTENDED ADDRESSING EXTRAS
CREATE EXTRA HERE 10 ALLOT 10 ERASE
: EXTRA? MORE?
IF >R R@ INDEX? DOUBLE? EXTRA 1 + SWAP
IF 2! 2 ELSE ! 1 THEN EXTRA C! R>
ELSE 0 EXTRA ! THEN ;
: ,EXTRA EXTRA C@ ?DUP
IF EXTRA 1 + SWAP 1 =
IF @ w, ELSE 2@ , THEN EXTRA 10 ERASE
THEN ;
\ IMMEDIATE & ADDRESS REGISTER SPECIFIC INSTRUCTIONS
: IMM CREATE , DOES> @ >R EXTRA? EAS R> OR SZ3 w, LONG? ?, ,EXTRA ;
0000 IMM ORI
1000 IMM ANDI
2000 IMM SUBI
3000 IMM ADDI
5000 IMM EORI
6000 IMM CMPI
: IMMSR CREATE , DOES> @ SZ3 , ;
001074 IMMSR ANDI>SR
005074 IMMSR EORI>SR
000074 IMMSR ORI>SR
: IQ CREATE , DOES> @ >R EXTRA? EAS SWAP RS 1000 * OR R> OR SZ3 w, ,EXTRA ;
050000 IQ ADDQ
050400 IQ SUBQ
: IEAA CREATE , DOES> @ DST SRC SZ4 w, ,MORE ;
150300 IEAA ADDA
130300 IEAA CMPA
040700 IEAA LEA
110300 IEAA SUBA
\ SHIFTS, ROTATES, & BIT MANIPULATION
: ISR CREATE , DOES> @ >R DN?
IF SWAP DN? IF R> 40 OR >R ELSE DROP SWAP 1000 * THEN
RD SWAP RS OR R> OR 160000 OR SZ3 w,
ELSE DUP EAS 300 OR R@ 400 AND OR R> 70 AND 100 * OR
160000 OR w, ,MORE
THEN ;
400 ISR ASL
000 ISR ASR
410 ISR LSL
010 ISR LSR
420 ISR ROXL
020 ISR ROXR
430 ISR ROL
030 ISR ROR
: IBIT CREATE , DOES> @ >R EXTRA? DN?
IF RD SRC 400 ELSE DROP DUP EAS 4000 THEN
OR R> OR w, ,EXTRA ,MORE ;
000 IBIT BTST
100 IBIT BCHG
200 IBIT BCLR
300 IBIT BSET
\ BRANCH, LOOP, & SET CONDITIONALS
: SETCLASS ' SWAP 0 DO I OVER EXECUTE LOOP DROP ;
: SETCLAS2 ' ROT ROT DO I OVER EXECUTE LOOP DROP ;
: IBRA 400 * 060000 OR CREATE ,
DOES> @ SWAP HERE 2 + - DUP ABS 200 <
IF LOW OR w, ELSE SWAP , THEN ;
: IDBR 400 * 050310 OR CREATE ,
DOES> @ SWAP RS OR w, HERE - , ;
: ISET 400 * 050300 OR CREATE ,
DOES> @ SRC w, ,MORE ;
20 SETCLASS IBRA BRA BSR BHI BLS BCC BCS BNE BEQ BVC BVS BPL BMI BGE BLT BGT BLE
10 SETCLASS IDBR DXIT DBRA DBHI DBLS DBCC DBCS DBNE DBEQ
20 10 SETCLAS2 IDBR DBVC DBVS DBPL DBMI DBGE DBLT DBGT DBLE
20 SETCLASS ISET SET SNO SHI SLS SCC SCS SNE SEQ SVC SVS SPL SMI SGE SLT SGT SLE
\ MOVES
: MOVE EXTRA? 7700 AND SRC SZ300 w, ,MORE ,EXTRA ;
: MOVEQ RD SWAP LOW OR 070000 OR w, ;
: MOVE>USP RS 047140 OR w, ;
: MOVE<USP RS 047150 OR w, ;
: MOVEM> EXTRA? EAS 044200 OR -SZ1 w, w, ,EXTRA ;
: MOVEM< EXTRA? EAS 046200 OR -SZ1 w, w, ,EXTRA ;
: MOVEP DN? IF RD SWAP RS OR 410 OR
ELSE RS ROT RD OR 610 OR
THEN -SZ1 , ;
: LMOVE 7700 AND SWAP EAS OR 20000 OR w, ;
\ ODDS AND ENDS
: CMPM RD SWAP RS OR 130410 OR SZ3 w, ;
: EXG
DN? IF SWAP DN? IF 140500 ELSE 140610 THEN >R
ELSE SWAP DN? IF 140610 ELSE 140510 THEN >R SWAP
THEN RS DST R> OR w, ;
: EXT RS 044200 OR -SZ1 w, ;
: SWAP RS 044100 OR w, ;
: STOP 47162 , ;
: TRAP 17 AND 47100 OR w, ;
: LINK RS 047120 OR , ;
: UNLK RS 047130 OR w, ;
\ ARITHMETIC & LOGIC
: EOR EXTRA? EAS DST SZ3 130400 OR w, ,EXTRA ;
: IDD CREATE ,
DOES> @ DST OVER RS OR *SWAP MS IF 10 OR THEN w, ;
140400 IDD ABCD
100400 IDD SBCD
150300 IDD ADDX
110400 IDD SUBX
: IDEA CREATE ,
DOES> @ >R DN?
IF RD SRC R> OR SZ3 w, ,MORE
ELSE EXTRA? EAS DST 400 OR R> OR SZ3 w, ,EXTRA THEN ;
150000 IDEA ADD
110000 IDEA SUB
140000 IDEA AND
100000 IDEA OR
: IEAD CREATE , DOES> @ DST SRC w, ,MORE ;
040600 IEAD CHK
100300 IEAD DIVU
100700 IEAD DIVS
140300 IEAD MULU
140700 IEAD MULS
: CMP 130000 DST SRC SZ3 w, ,MORE ;
\ ARITHMETIC & CONTROL
: IEA CREATE , DOES> @ SRC w, ,MORE ;
047200 IEA JSR
047300 IEA JMP
042300 IEA MOVE>CCR
040300 IEA MOVE<SR
043300 IEA MOVE>SR
044000 IEA NBCD
044100 IEA PEA
045300 IEA TAS
: IEAS CREATE , DOES> @ SRC SZ3 w, ,MORE ;
041000 IEAS CLR
043000 IEAS NOT
042000 IEAS NEG
040000 IEAS NEGX
045000 IEAS TST
: ICON CREATE , DOES> @ w, ;
47160 ICON RESET
47161 ICON NOP
47163 ICON RTE
47165 ICON RTS
47166 ICON TRAPV
47167 ICON RTR
\ STRUCTURED CONDITIONALS ( +/- 256 BYTES )
: THEN HERE OVER 2 + - *SWAP 1 + C! ;
: ENDIF THEN ;
: IF w, HERE 2 - ;
HEX
: ELSE 6000 IF *SWAP THEN ;
: BEGIN HERE ;
: UNTIL , HERE - HERE 1 - C! ;
: AGAIN 6000 UNTIL ;
: WHILE IF ;
: REPEAT *SWAP AGAIN THEN ;
: DO HERE *SWAP ;
: LOOP DBRA ;
6600 CONSTANT 0=
6700 CONSTANT 0<>
6A00 CONSTANT 0<
6B00 CONSTANT 0>=
6C00 CONSTANT <
6D00 CONSTANT >=
6E00 CONSTANT <=
6F00 CONSTANT >
DECIMAL
: NEXT
A5 )+ A0 LMOVE
A0 ) JMP ;
FORTH DEFINITIONS
: LABEL CREATE [COMPILE] ASSEMBLER ASSEMBLER WORD ;
: CODE LABEL HERE CELL- CELL- CELL- CP ! ;