aboutsummaryrefslogtreecommitdiff
path: root/test/asm68k.4th
diff options
context:
space:
mode:
Diffstat (limited to 'test/asm68k.4th')
-rw-r--r--test/asm68k.4th608
1 files changed, 300 insertions, 308 deletions
diff --git a/test/asm68k.4th b/test/asm68k.4th
index a549d69c17c6..fdfb8495fd48 100644
--- a/test/asm68k.4th
+++ b/test/asm68k.4th
@@ -1,308 +1,300 @@
-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 ! ;
-
-
-
-
---openmail-part-01d4752f-00000002--
-
---openmail-part-01d4752f-00000001--
-
-
+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 ! ;
+
generated by cgit v1.2.3 (git 2.25.1) at 2024-04-24 06:18:56 +0000