\ asm68k.part2 of 2 v1.3 NAB
\ Included by asm68k.

private:

\ 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 )
5 setclass ibra BRA BSR BHI BLS BCC 
5 setclass ibra BCS BNE BEQ BVC BVS
5 setclass ibra BPL BMI BGE BLT BGT
1 setclass ibra BLE

: idbr  400 *  050310 or  instr:
  swap  rs or  cs,  cshere -  cs, ;
( target Dn )
4 setclass idbr DXIT DBRA DBHI DBLS
4 setclass idbr DBCC DBCS DBNE DBEQ
4 setclass idbr DBVC DBVS DBPL DBMI
4 setclass idbr DBGE DBLT DBGT DBLE

: iset  400 *  050300 or instr:
  src cs, ,more ;
( ea )
6 setclass iset ST SF SHI SLS SCC SCS
5 setclass iset SNE SEQ SVC SVS SPL
5 setclass iset SMI SGE 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
  [ also forth ] swap [ previous ] 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
