\ 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 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 MOVESCR 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