\ asm68k.part2 v1.21
\ Branch, loop & set conditionals:
: setclass ' swap
0 do i over execute loop drop ;
: ibra
400 * 060000 or instr:
swap cshere cell+ - dup abs 200 <
if low or cs, else swap 2, then ;
( target )
20 setclass ibra BRA BSR BHI BLS BCC BCS BNE BEQ BVC BVS BPL BMI BGE BLT BGT BLE
: idbr 400 * 050310 or instr:
swap rs or cs, cshere - cs, ;
( target Dn )
20 setclass idbr DXIT DBRA DBHI DBLS DBCC DBCS DBNE DBEQ DBVC DBVS DBPL DBMI DBGE DBLT DBGT DBLE
: iset 400 * 050300 or instr:
src cs, ,more ;
( ea )
20 setclass iset SET SNO SNI SLS SCC SCS SNE SEQ SVC SVS SPL SMI SSE SLT SGT SLE
\ Moves:
: MOVE fix extra? 7700 and src sz300
cs, ,more ,extra ; ( ea ea )
: MOVEQ fix rd swap low or
070000 or cs, ; ( n Dn )
: MOVE>USP fix rs 047140 or cs, ; ( An )
: MOVE<USP fix rs 047150 or cs, ; ( An )
: MOVEM> fix extra? eas
044200 or -sz1 2, ,extra ; ( n ea )
: MOVEM< fix extra? eas
046200 or -sz1 2, ,extra ; ( n ea )
: MOVEP fix
dn? if rd swap rs or 410 or
else rs rot rd or 610 or then -sz1 2, ; ( Da d An ) ( d An Da )
\ Odds & ends:
: CMPM
fix rd swap rs or 130410 or sz3 cs, ; ( An@+ Am@+ )
: EXG
fix 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 cs, ; ( Rn Ra )
: EXT fix rs 044200 or -sz1 cs, ; ( Dn )
: SWAP fix rs 044100 or cs, ; ( Dn )
: STOP fix 47162 2, ; ( n )
: TRAP fix 17 and 47100 or cs, ; ( n )
: LINK fix rs 047120 or 2, ; ( n An )
: UNLK fix rs 047130 or cs, ; ( An )
: EOR fix extra? eas dst sz3 130400 or cs, ,extra ; ( Dn ea )
: CMP fix 130000 dst src sz3 cs, ,more ; ( ea Dn )
\ Arith. & logic:
: ibcd instr: dst over rs or
[ forth ] swap [ assembler ] ms
if 10 or then cs, ;
( Dn Dm ) ( An@- Am@ )
140400 ibcd ABCD
100400 ibcd SBCD
: idd instr: dst over rs or
[ forth ] swap [ assembler ] ms
if 10 or then sz3 cs, ;
( Dn Dm ) ( An@- Am@ )
150400 idd ADDX
110400 idd SUBX
: idea
instr: >r dn?
if rd src r> or sz3 cs, ,more
else extra? eas dst 400 or
r> or sz3 cs, ,extra then ;
( ea Dn ) ( Dn ea )
150000 idea ADD
110000 idea SUB
140000 idea AND
100000 idea OR
: iead instr: dst src cs, ,more ;
( ea Dn )
040600 iead CHK
100300 iead DIVU
100700 iead DIVS
140300 iead MULU
140700 iead MULS
\ Arith. & control:
: iea instr: src cs, ,more ;
( ea )
047200 iea JSR
047300 iea JMP
042300 iea MOVE>CCR
040300 iea MOVE<SCR
043300 iea MOVE>SCR
044000 iea NBCD
044100 iea PEA
045300 iea TAS
: ieas instr: src sz3 cs, ,more ;
( ea )
041000 ieas CLR
043000 ieas NOT
042000 ieas NEG
040000 ieas NEGX
045000 ieas TST
: icon instr: cs, ;
( -- )
47160 icon RESET
47161 icon NOP
47163 icon RTE
47165 icon RTS
\ Struct. conditionals +/- 128 bytes:
: THEN ( fwdref -- )
cshere over cell+ -
[ forth ] swap 1+ csc! ; assembler
: IF ( condition -- fwdref )
cs, cshere 1 cells - ; hex
: ELSE ( oldfwdref -- newfwdref )
6000 IF [ forth ] swap
[ assembler ] THEN ;
: BEGIN ( -- target ) cshere ;
: UNTIL ( target cond -- )
cs, cshere - cshere 1- csc! ;
: AGAIN ( target -- ) 6000 UNTIL ;
: WHILE ( cond -- fwdref ) IF ;
: REPEAT ( target fwdref -- )
[ forth ] swap [ assembler ]
AGAIN THEN ;
: FOR ( Dn -- Dn target )
BEGIN [ forth ] swap ; assembler
: NEXT ( Dn target -- ) dbra ;
6600 constant 0=
6700 constant 0<>
6a00 constant 0<
6b00 constant 0>=
6c00 constant <
6d00 constant >=
6e00 constant <=
6f00 constant >
decimal