0<> IF MOV #0,R14 THEN
MOV R14,0(R15)
MOV &$180A,R14
- SUB #309,R14
+ SUB #400,R14
COLON
$0D EMIT
- ABORT" FastForth V3.9 please!"
- ABORT" build FastForth with DOUBLE_INPUT addon !"
+ ABORT" FastForth V4.0 please!"
+ ABORT" build FastForth with DOUBLE_INPUT addon!"
RST_RET
;
; -----------------------------------------------------
; DOUBLE.4th for MSP_EXP430FR5994
; -----------------------------------------------------
+ [DEFINED] {DOUBLE}
+ [IF] {DOUBLE} [THEN]
+ [UNDEFINED] {DOUBLE} [IF]
MARKER {DOUBLE}
- [UNDEFINED] >R
- [IF]
+; ------------------------------------------------------------------
+; first we download the set of definitions we need (from CORE_ANS)
+; ------------------------------------------------------------------
+
+ [UNDEFINED] >R [IF]
CODE >R
PUSH R14
MOV @R15+,R14
ENDCODE
[THEN]
- [UNDEFINED] R>
- [IF]
+ [UNDEFINED] R> [IF]
CODE R>
SUB #2,R15
MOV R14,0(R15)
ENDCODE
[THEN]
- [UNDEFINED] 0<
- [IF]
+ [UNDEFINED] 0< [IF]
CODE 0<
ADD R14,R14
SUBC R14,R14
ENDCODE
[THEN]
- [UNDEFINED] DROP
- [IF]
+ [UNDEFINED] DROP [IF]
CODE DROP
MOV @R15+,R14
MOV @R13+,R0
ENDCODE
[THEN]
- [UNDEFINED] DUP
- [IF]
+ [UNDEFINED] DUP [IF]
CODE DUP
BW1 SUB #2,R15
MOV R14,0(R15)
ENDCODE
[THEN]
- [UNDEFINED] NIP
- [IF]
+ [UNDEFINED] NIP [IF]
CODE NIP
ADD #2,R15
MOV @R13+,R0
ENDCODE
[THEN]
- [UNDEFINED] UM/MOD
- [IF]
+ [UNDEFINED] UM/MOD [IF]
CODE UM/MOD
PUSH #DROP
- MOV #$403E,R0
+ MOV #$4028,R0
ENDCODE
[THEN]
- $180E @ 0< ; test the switch: $8000 / SYMETRIC DIVISION
- [IF] ; $8000 DIVISION
- [UNDEFINED] FM/MOD
+ $180E @ 0< ; test the switch: FLOORED/SYMETRIC DIVISION
[IF]
- CODE FM/MOD
- MOV R14,R12
- MOV @R15,R11
- CMP #0,R14
- S< IF
- XOR #-1,R14
- ADD #1,R14
- THEN
- CMP #0,0(R15)
- S< IF
- XOR #-1,2(R15)
- XOR #-1,0(R15)
- ADD #1,2(R15)
- ADDC #0,0(R15)
- THEN
- PUSHM #3,R13
- LO2HI
- UM/MOD
- HI2LO
- POPM #3,R13
- CMP #0,R11
- S< IF
- XOR #-1,0(R15)
- ADD #1,0(R15)
- THEN
- XOR R12,R11
- CMP #0,R11
- S< IF
- XOR #-1,R14
- ADD #1,R14
- THEN
-
- CMP #0,0(R15)
- 0<> IF
- CMP #1,R14
+ [UNDEFINED] FM/MOD [IF]
+ CODE FM/MOD
+ MOV R14,R12
+ MOV @R15,R11
+ CMP #0,R14
S< IF
- ADD R12,0(R15)
- SUB #1,R14
+ XOR #-1,R14
+ ADD #1,R14
THEN
- THEN
- MOV @R13+,R0
- ENDCODE
- [THEN]
+ CMP #0,0(R15)
+ S< IF
+ XOR #-1,2(R15)
+ XOR #-1,0(R15)
+ ADD #1,2(R15)
+ ADDC #0,0(R15)
+ THEN
+ PUSHM #3,R13
+ LO2HI
+ UM/MOD
+ HI2LO
+ POPM #3,R13
+ CMP #0,R11
+ S< IF
+ XOR #-1,0(R15)
+ ADD #1,0(R15)
+ THEN
+ XOR R12,R11
+ CMP #0,R11
+ S< IF
+ XOR #-1,R14
+ ADD #1,R14
+ THEN
+
+ CMP #0,0(R15)
+ 0<> IF
+ CMP #1,R14
+ S< IF
+ ADD R12,0(R15)
+ SUB #1,R14
+ THEN
+ THEN
+ MOV @R13+,R0
+ ENDCODE
+ [THEN]
- [ELSE] ; SYMETRIC DIVISION
- [UNDEFINED] SM/REM
- [IF]
- CODE SM/REM
- MOV R14,R12
- MOV @R15,R11
- CMP #0,R14
- S< IF
- XOR #-1,R14
- ADD #1,R14
- THEN
- CMP #0,0(R15)
- S< IF
- XOR #-1,2(R15)
- XOR #-1,0(R15)
- ADD #1,2(R15)
- ADDC #0,0(R15)
- THEN
- PUSHM #3,R13
- LO2HI
- UM/MOD
- HI2LO
- POPM #3,R13
- CMP #0,R11
- S< IF
- XOR #-1,0(R15)
- ADD #1,0(R15)
- THEN
- XOR R12,R11
- CMP #0,R11
- S< IF
- XOR #-1,R14
- ADD #1,R14
- THEN
- MOV @R13+,R0
- ENDCODE
- [THEN]
+ [ELSE]
+ [UNDEFINED] SM/REM [IF]
+ CODE SM/REM
+ MOV R14,R12
+ MOV @R15,R11
+ CMP #0,R14
+ S< IF
+ XOR #-1,R14
+ ADD #1,R14
+ THEN
+ CMP #0,0(R15)
+ S< IF
+ XOR #-1,2(R15)
+ XOR #-1,0(R15)
+ ADD #1,2(R15)
+ ADDC #0,0(R15)
+ THEN
+ PUSHM #3,R13
+ LO2HI
+ UM/MOD
+ HI2LO
+ POPM #3,R13
+ CMP #0,R11
+ S< IF
+ XOR #-1,0(R15)
+ ADD #1,0(R15)
+ THEN
+ XOR R12,R11
+ CMP #0,R11
+ S< IF
+ XOR #-1,R14
+ ADD #1,R14
+ THEN
+ MOV @R13+,R0
+ ENDCODE
+ [THEN]
[THEN]
- [UNDEFINED] /
- [IF]
+ [UNDEFINED] / [IF]
: /
>R DUP 0< R>
- [ $180E @ 0< ] [IF]
- FM/MOD
- [ELSE]
- SM/REM
+ [ $180E @ 0< ]
+ [IF] FM/MOD
+ [ELSE] SM/REM
[THEN]
NIP
;
[THEN]
- [UNDEFINED] @
- [IF]
- CODE @
- MOV @R14,R14
- MOV @R13+,R0
- ENDCODE
- [THEN]
-
- [UNDEFINED] !
- [IF]
- CODE !
- MOV @R15+,0(R14)
- MOV @R15+,R14
- MOV @R13+,R0
- ENDCODE
- [THEN]
-
- [UNDEFINED] C@
- [IF]
+ [UNDEFINED] C@ [IF]
CODE C@
MOV.B @R14,R14
MOV @R13+,R0
ENDCODE
[THEN]
- [UNDEFINED] SWAP
- [IF]
+ [UNDEFINED] SWAP [IF]
CODE SWAP
MOV @R15,R10
MOV R14,0(R15)
ENDCODE
[THEN]
- [UNDEFINED] OVER
- [IF]
+ [UNDEFINED] OVER [IF]
CODE OVER
MOV R14,-2(R15)
MOV @R15,R14
ENDCODE
[THEN]
- [UNDEFINED] ROT
- [IF]
+ [UNDEFINED] ROT [IF]
CODE ROT
MOV @R15,R10
MOV R14,0(R15)
ENDCODE
[THEN]
- [UNDEFINED] -
- [IF]
+ [UNDEFINED] - [IF]
CODE -
SUB @R15+,R14
XOR #-1,R14
ENDCODE
[THEN]
- [UNDEFINED] <
- [IF]
+ [UNDEFINED] < [IF]
CODE <
SUB @R15+,R14
S< ?GOTO FW1
ENDCODE
[THEN]
- [UNDEFINED] IF
- [IF]
+ [UNDEFINED] IF [IF]
CODE IF
SUB #2,R15
MOV R14,0(R15)
- MOV &$1DC8,R14
- ADD #4,&$1DC8
- MOV #$40AC,0(R14)
+ MOV &$1DC0,R14
+ ADD #4,&$1DC0
+ MOV #$4096,0(R14)
ADD #2,R14
MOV @R13+,R0
ENDCODE IMMEDIATE
CODE THEN
- MOV &$1DC8,0(R14)
+ MOV &$1DC0,0(R14)
MOV @R15+,R14
MOV @R13+,R0
ENDCODE IMMEDIATE
[THEN]
- [UNDEFINED] ELSE
- [IF]
+ [UNDEFINED] ELSE [IF]
CODE ELSE
- ADD #4,&$1DC8
- MOV &$1DC8,R10
- MOV #$40B2,-4(R10)
+ ADD #4,&$1DC0
+ MOV &$1DC0,R10
+ MOV #$409C,-4(R10)
MOV R10,0(R14)
SUB #2,R10
MOV R10,R14
ENDCODE IMMEDIATE
[THEN]
- [UNDEFINED] TO
- [IF]
+ [UNDEFINED] TO [IF]
CODE TO
BIS #$200,R2
MOV @R13+,R0
ENDCODE
[THEN]
- [UNDEFINED] DOES>
- [IF]
+ [UNDEFINED] DOES> [IF]
CODE DOES>
- MOV &$1DB8,R10
+ MOV &$1DDC,R10
MOV #$1285,0(R10)
MOV R13,2(R10)
MOV @R1+,R13
ENDCODE
[THEN]
- [UNDEFINED] SPACES
- [IF]
+ [UNDEFINED] SPACES [IF]
CODE SPACES
CMP #0,R14
0<> IF
ENDCODE
[THEN]
- [UNDEFINED] 2@
- [IF]
+ [UNDEFINED] 2@ [IF]
CODE 2@
SUB #2,R15
MOV 2(R14),0(R15)
ENDCODE
[THEN]
- [UNDEFINED] 2!
- [IF]
+ [UNDEFINED] 2! [IF]
CODE 2!
MOV @R15+,0(R14)
MOV @R15+,2(R14)
ENDCODE
[THEN]
- [UNDEFINED] 2DUP
- [IF]
+ [UNDEFINED] 2DUP [IF]
CODE 2DUP
SUB #4,R15
MOV R14,2(R15)
ENDCODE
[THEN]
- [UNDEFINED] 2DROP
- [IF]
+ [UNDEFINED] 2DROP [IF]
CODE 2DROP
ADD #2,R15
MOV @R15+,R14
ENDCODE
[THEN]
- [UNDEFINED] 2SWAP
- [IF]
+ [UNDEFINED] 2SWAP [IF]
CODE 2SWAP
MOV @R15,R10
MOV 4(R15),0(R15)
ENDCODE
[THEN]
- [UNDEFINED] 2OVER
- [IF]
+ [UNDEFINED] 2OVER [IF]
CODE 2OVER
SUB #4,R15
MOV R14,2(R15)
ENDCODE
[THEN]
- [UNDEFINED] 2>R
- [IF]
+ [UNDEFINED] 2>R [IF]
CODE 2>R
PUSH @R15+
PUSH R14
ENDCODE
[THEN]
- [UNDEFINED] 2R@
- [IF]
+ [UNDEFINED] 2R@ [IF]
CODE 2R@
SUB #4,R15
MOV R14,2(R15)
ENDCODE
[THEN]
- [UNDEFINED] 2R>
- [IF]
+ [UNDEFINED] 2R> [IF]
CODE 2R>
SUB #4,R15
MOV R14,2(R15)
ENDCODE
[THEN]
+; --------------------------
+; end of definitions we need
+; --------------------------
- [UNDEFINED] D.
- [IF]
+; ===============================================
+; DOUBLE word set
+; ===============================================
+
+ [UNDEFINED] D. [IF]
CODE D.
MOV R14,R12
- MOV #U.+10,R0
+ MOV #U.+$0A,R0
ENDCODE
[THEN]
- [UNDEFINED] 2ROT
- [IF]
+ [UNDEFINED] 2ROT [IF]
CODE 2ROT
MOV 8(R15),R9
MOV 6(R15),R8
ENDCODE
[THEN]
- [UNDEFINED] D>S
- [IF]
+ [UNDEFINED] D>S [IF]
CODE D>S
MOV @R15+,R14
MOV @R13+,R0
ENDCODE
[THEN]
- [UNDEFINED] D0=
- [IF]
+ [UNDEFINED] D0= [IF]
+
CODE D0=
+ ADD #2,R15
CMP #0,R14
MOV #0,R14
0= IF
- CMP #0,0(R15)
+ CMP #0,-2(R15)
0= IF
- MOV #-1,R14
+BW1 MOV #-1,R14
THEN
THEN
- ADD #2,R15
+BW2 AND #-1,R14
MOV @R13+,R0
ENDCODE
- [THEN]
- [UNDEFINED] D0<
- [IF]
CODE D0<
+ ADD #2,R15
CMP #0,R14
MOV #0,R14
- S< IF
- MOV #-1,R14
- THEN
- ADD #2,R15
- AND #-1,R14
- MOV @R13+,R0
+ S< ?GOTO BW1
+ GOTO BW2
ENDCODE
- [THEN]
- [UNDEFINED] D=
- [IF]
CODE D=
- CMP R14,2(R15)
- MOV #0,R14
- 0= IF
- CMP @R15,4(R15)
- 0= IF
- MOV #-1,R14
- THEN
- THEN
ADD #6,R15
- MOV @R13+,R0
+ CMP R14,-4(R15)
+ MOV #0,R14
+ 0<> ?GOTO BW2
+ CMP -6(R15),-2(R15)
+ 0= ?GOTO BW1
+ GOTO BW2
ENDCODE
- [THEN]
- [UNDEFINED] D<
- [IF]
CODE D<
- CMP R14,2(R15)
+ ADD #6,R15
+ CMP R14,-4(R15)
MOV #0,R14
S< IF
- MOV #-1,R14
+BW1 MOV #-1,R14
THEN
- 0= IF
- CMP @R15,4(R15)
- U< IF
- MOV #-1,R14
- THEN
- THEN
- ADD #6,R15
- MOV @R13+,R0
+BW3 0<> ?GOTO BW2
+ CMP -6(R15),-2(R15)
+ U>= ?GOTO BW2
+ U< ?GOTO BW1
ENDCODE
- [THEN]
- [UNDEFINED] DU<
- [IF]
CODE DU<
- CMP R14,2(R15)
- MOV #0,R14
- U< IF
- MOV #-1,R14
- THEN
- 0= IF
- CMP @R15,4(R15)
- U< IF
- MOV #-1,R14
- THEN
- THEN
ADD #6,R15
- MOV @R13+,R0
+ CMP R14,-4(R15)
+ MOV #0,R14
+ U>= ?GOTO BW3
+ U< ?GOTO BW1
ENDCODE
[THEN]
- [UNDEFINED] D+
- [IF]
+ [UNDEFINED] D+ [IF]
CODE D+
BW1 ADD @R15+,2(R15)
ADDC @R15+,R14
ENDCODE
[THEN]
- [UNDEFINED] D-
- [IF]
+ [UNDEFINED] D- [IF]
CODE D-
SUB @R15+,2(R15)
SUBC R14,0(R15)
ENDCODE
[THEN]
- [UNDEFINED] DNEGATE
- [IF]
+ [UNDEFINED] DNEGATE [IF]
CODE DNEGATE
- XOR #-1,0(R15)
+BW1 XOR #-1,0(R15)
XOR #-1,R14
ADD #1,0(R15)
ADDC #0,R14
MOV @R13+,R0
ENDCODE
- [THEN]
- [UNDEFINED] DABS
- [IF]
CODE DABS
CMP #0,R14
- 0>= IF
- MOV @R13+,R0
- THEN
- MOV #DNEGATE,R0
+ 0< ?GOTO BW1
+ MOV @R13+,R0
ENDCODE
[THEN]
- [UNDEFINED] D2/
- [IF]
+ [UNDEFINED] D2/ [IF]
CODE D2/
RRA R14
RRC 0(R15)
ENDCODE
[THEN]
- [UNDEFINED] D2*
- [IF]
+ [UNDEFINED] D2* [IF]
CODE D2*
ADD @R15,0(R15)
ADDC R14,R14
ENDCODE
[THEN]
- [UNDEFINED] DMAX
- [IF]
+ [UNDEFINED] DMAX [IF]
: DMAX
2OVER 2OVER
D< IF
;
[THEN]
- [UNDEFINED] DMIN
- [IF]
+ [UNDEFINED] DMIN [IF]
: DMIN
2OVER 2OVER
D< IF
;
[THEN]
- RST_SET
+ [UNDEFINED] M*/ [IF]
- CODE TSTBIT
- MOV @R15+,R9
- AND @R9,R14
- MOV @R13+,R0
- ENDCODE
+ RST_SET
- $180E 1 TSTBIT
+ CODE TSTBIT
+ MOV @R15+,R9
+ AND @R9,R14
+ MOV @R13+,R0
+ ENDCODE
- RST_RET
+ $180E 8 TSTBIT
- [IF] ; MSP430FRxxxx with hardware_MPY
-
- [UNDEFINED] M*/
- [IF]
- CODE M*/
- MOV 4(R15),&$4D4
- MOV 2(R15),&$4D6
- MOV @R15+,&$4C8
- MOV R14,R11
- MOV R0,R0
- MOV &$4E4,R12
- MOV &$4E6,R14
- MOV &$4E8,R10
- MOV #0,R6
- CMP #0,R10
- S< IF
- XOR #-1,R12
- XOR #-1,R14
- XOR #-1,R10
- ADD #1,R12
- ADDC #0,R14
- ADDC #0,R10
- MOV #-1,R6
- THEN
+ RST_RET
- [ELSE] ; no hardware multiplier
- [UNDEFINED] M*/
- [IF]
- CODE M*/
- MOV #0,R6
- CMP #0,2(R15)
- S< IF
- XOR #-1,4(R15)
- XOR #-1,2(R15)
- ADD #1,4(R15)
- ADDC #0,2(R15)
- MOV #-1,R6
- THEN
- CMP #0,0(R15)
- S< IF
- XOR #-1,0(R15)
- ADD #1,0(R15)
- XOR #-1,R6
- THEN
- MOV 4(R15),R8
- MOV 2(R15),R11
- MOV @R15+,R12
- MOV #0,R5
- MOV #0,2(R15)
- MOV #0,0(R15)
- MOV #0,R10
- MOV #1,R9
- BEGIN BIT R9,R12
- 0<> IF ADD R8,2(R15)
- ADDC R11,0(R15)
- ADDC R5,R10
- THEN ADD R8,R8
- ADDC R11,R11
- ADDC R5,R5
- ADD R9,R9
- U>= UNTIL
- MOV R14,R11
- MOV @R15,R14
- MOV 2(R15),R12
- [THEN]
+ [IF] ; MSP430FRxxxx with hardware_MPY
+
+ CODE M*/
+ MOV 4(R15),&$4D4
+ MOV 2(R15),&$4D6
+ MOV @R15+,&$4C8
+ MOV R14,R11
+ MOV R0,R0
+ MOV &$4E4,R12
+ MOV &$4E6,R14
+ MOV &$4E8,R10
+ MOV #0,R6
+ CMP #0,R10
+ S< IF
+ XOR #-1,R12
+ XOR #-1,R14
+ XOR #-1,R10
+ ADD #1,R12
+ ADDC #0,R14
+ ADDC #0,R10
+ MOV #-1,R6
+ THEN
+
+ [ELSE] ; no hardware multiplier
+
+ CODE M*/
+ MOV #0,R6
+ CMP #0,2(R15)
+ S< IF
+ XOR #-1,4(R15)
+ XOR #-1,2(R15)
+ ADD #1,4(R15)
+ ADDC #0,2(R15)
+ MOV #-1,R6
+ THEN
+ CMP #0,0(R15)
+ S< IF
+ XOR #-1,0(R15)
+ ADD #1,0(R15)
+ XOR #-1,R6
+ THEN
+ MOV 4(R15),R8
+ MOV 2(R15),R11
+ MOV @R15+,R12
+ MOV #0,R5
+ MOV #0,2(R15)
+ MOV #0,0(R15)
+ MOV #0,R10
+ MOV #1,R9
+ BEGIN BIT R9,R12
+ 0<> IF ADD R8,2(R15)
+ ADDC R11,0(R15)
+ ADDC R5,R10
+ THEN ADD R8,R8
+ ADDC R11,R11
+ ADDC R5,R5
+ ADD R9,R9
+ U>= UNTIL
+ MOV R14,R11
+ MOV @R15,R14
+ MOV 2(R15),R12
[THEN] ; endcase of software/hardware_MPY
CMP #0,R10
0= IF
MOV R14,R10
- CALL #$4050
+ CALL #$403A
ELSE
- CALL #$4058
+ CALL #$4042
THEN
MOV @R15+,0(R15)
CMP #0,R6
THEN
THEN
THEN
- MOV #$40B6,R5
- MOV #$40C4,R6
+ MOV #$40A0,R5
+ MOV #$40AE,R6
MOV @R13+,R0
ENDCODE
[THEN]
- [UNDEFINED] 2VARIABLE
- [IF]
+ [UNDEFINED] 2VARIABLE [IF]
: 2VARIABLE
CREATE
HI2LO
- ADD #4,&$1DC8
+ ADD #4,&$1DC0
MOV @R1+,R13
MOV @R13+,R0
ENDCODE
[THEN]
- [UNDEFINED] 2CONSTANT
- [IF]
+ [UNDEFINED] 2CONSTANT [IF]
: 2CONSTANT
CREATE
, ,
;
[THEN]
- [UNDEFINED] 2VALUE
- [IF]
+ [UNDEFINED] 2VALUE [IF]
: 2VALUE
CREATE , ,
DOES>
[THEN]
- [UNDEFINED] 2LITERAL
- [IF]
- CODE 2LITERAL
- BIS #$200,R2
- MOV #LITERAL,R0
- ENDCODE IMMEDIATE
+ [UNDEFINED] 2LITERAL [IF]
+ CODE 2LITERAL
+ BIS #$200,R2
+ MOV #LITERAL,R0
+ ENDCODE IMMEDIATE
[THEN]
- [UNDEFINED] D.R
- [IF]
+ [UNDEFINED] D.R [IF]
: D.R
>R SWAP OVER DABS <# #S ROT SIGN #>
R> OVER - SPACES TYPE
RST_SET
+ [THEN]
+
+; -------------------------------
; Complement to pass DOUBLE TESTS
+; -------------------------------
- [UNDEFINED] VARIABLE
- [IF]
+ [UNDEFINED] SWAP [IF]
+ CODE SWAP
+ MOV @R15,R10
+ MOV R14,0(R15)
+ MOV R10,R14
+ MOV @R13+,R0
+ ENDCODE
+ [THEN]
+
+ [UNDEFINED] VARIABLE [IF]
: VARIABLE
CREATE
HI2LO
ENDCODE
[THEN]
- [UNDEFINED] CONSTANT
- [IF]
+ [UNDEFINED] CONSTANT [IF]
: CONSTANT
CREATE
HI2LO
ENDCODE
[THEN]
- [UNDEFINED] CELLS
- [IF]
+ [UNDEFINED] CELLS [IF]
CODE CELLS
ADD R14,R14
MOV @R13+,R0
ENDCODE
[THEN]
- [UNDEFINED] DEPTH
- [IF]
+ [UNDEFINED] DEPTH [IF]
CODE DEPTH
MOV R14,-2(R15)
MOV #$1C80,R14
ENDCODE
[THEN]
- [UNDEFINED] DO
- [IF]
+ [UNDEFINED] IF [IF]
+ CODE IF
+ SUB #2,R15
+ MOV R14,0(R15)
+ MOV &$1DC0,R14
+ ADD #4,&$1DC0
+ MOV #$4096,0(R14)
+ ADD #2,R14
+ MOV @R13+,R0
+ ENDCODE IMMEDIATE
+
+ CODE THEN
+ MOV &$1DC0,0(R14)
+ MOV @R15+,R14
+ MOV @R13+,R0
+ ENDCODE IMMEDIATE
+ [THEN]
+
+ [UNDEFINED] ELSE [IF]
+ CODE ELSE
+ ADD #4,&$1DC0
+ MOV &$1DC0,R10
+ MOV #$409C,-4(R10)
+ MOV R10,0(R14)
+ SUB #2,R10
+ MOV R10,R14
+ MOV @R13+,R0
+ ENDCODE IMMEDIATE
+ [THEN]
+
+ [UNDEFINED] DO [IF]
HDNCODE XDO
MOV #$8000,R9
CODE DO
SUB #2,R15
MOV R14,0(R15)
- ADD #2,&$1DC8
- MOV &$1DC8,R14
+ ADD #2,&$1DC0
+ MOV &$1DC0,R14
MOV #XDO,-2(R14)
ADD #2,&$1C00
MOV &$1C00,R10
CODE LOOP
MOV #XLOOP,R9
-BW2 ADD #4,&$1DC8
- MOV &$1DC8,R10
+BW2 ADD #4,&$1DC0
+ MOV &$1DC0,R10
MOV R9,-4(R10)
MOV R14,-2(R10)
BEGIN
ENDCODE IMMEDIATE
[THEN]
- [UNDEFINED] I
- [IF]
+ [UNDEFINED] I [IF]
CODE I
SUB #2,R15
MOV R14,0(R15)
ENDCODE
[THEN]
- [UNDEFINED] +
- [IF]
+ [UNDEFINED] + [IF]
CODE +
ADD @R15+,R14
MOV @R13+,R0
ENDCODE
[THEN]
- [UNDEFINED] =
- [IF]
+ [UNDEFINED] = [IF]
CODE =
SUB @R15+,R14
0<> IF
ENDCODE
[THEN]
- [UNDEFINED] 0=
- [IF]
+ [UNDEFINED] 0= [IF]
CODE 0=
SUB #1,R14
SUBC R14,R14
ENDCODE
[THEN]
- [UNDEFINED] SOURCE
- [IF]
+ [UNDEFINED] SOURCE [IF]
CODE SOURCE
SUB #4,R15
MOV R14,2(R15)
- MOV &$1DC2,R14
- MOV &$1DC4,0(R15)
+ MOV &$1DBA,R14
+ MOV &$1DBC,0(R15)
MOV @R13+,R0
ENDCODE
[THEN]
- [UNDEFINED] >IN
- [IF]
- $1DC6 CONSTANT >IN
+ [UNDEFINED] >IN [IF]
+ $1DBE CONSTANT >IN
[THEN]
- [UNDEFINED] 1+
- [IF]
+ [UNDEFINED] 1+ [IF]
CODE 1+
ADD #1,R14
MOV @R13+,R0
ENDCODE
[THEN]
- [UNDEFINED] CHAR
- [IF]
+ [UNDEFINED] CHAR [IF]
: CHAR
$20 WORD 1+ C@
;
[THEN]
- [UNDEFINED] [CHAR]
- [IF]
+ [UNDEFINED] [CHAR] [IF]
: [CHAR]
CHAR POSTPONE LITERAL
; IMMEDIATE
[THEN]
- [UNDEFINED] 2/
- [IF]
+ [UNDEFINED] 2/ [IF]
CODE 2/
RRA R14
MOV @R13+,R0
ENDCODE
[THEN]
- [UNDEFINED] INVERT
- [IF]
+ [UNDEFINED] INVERT [IF]
CODE INVERT
XOR #-1,R14
MOV @R13+,R0
ENDCODE
[THEN]
- [UNDEFINED] RSHIFT
- [IF]
+ [UNDEFINED] RSHIFT [IF]
CODE RSHIFT
MOV @R15+,R10
AND #$1F,R14
ENDCODE
[THEN]
- [UNDEFINED] S>D
- [IF]
+ [UNDEFINED] S>D [IF]
: S>D
DUP 0<
;
[THEN]
- [UNDEFINED] 1-
- [IF]
+ [UNDEFINED] 1- [IF]
CODE 1-
SUB #1,R14
MOV @R13+,R0
ENDCODE
[THEN]
- [UNDEFINED] NEGATE
- [IF]
+ [UNDEFINED] NEGATE [IF]
CODE NEGATE
XOR #-1,R14
ADD #1,R14
ENDCODE
[THEN]
- [UNDEFINED] HERE
- [IF]
+ [UNDEFINED] HERE [IF]
CODE HERE
- MOV #$4032,R0
+ MOV #BEGIN,R0
ENDCODE
[THEN]
- [UNDEFINED] CHARS
- [IF]
+ [UNDEFINED] CHARS [IF]
CODE CHARS
MOV @R13+,R0
ENDCODE
[THEN]
- [UNDEFINED] MOVE
- [IF]
+ [UNDEFINED] MOVE [IF]
CODE MOVE
MOV R14,R10
MOV @R15+,R8
ENDCODE
[THEN]
- [UNDEFINED] DECIMAL
- [IF]
+ [UNDEFINED] DECIMAL [IF]
CODE DECIMAL
- MOV #$0A,&$1DBE
+ MOV #$0A,&$1DB6
MOV @R13+,R0
ENDCODE
[THEN]
- [UNDEFINED] BASE
- [IF]
- $1DBE CONSTANT BASE
+ [UNDEFINED] BASE [IF]
+ $1DB6 CONSTANT BASE
[THEN]
- [UNDEFINED] ( ; )
- [IF]
+ [UNDEFINED] ( [IF]
: (
')' WORD DROP
; IMMEDIATE
[THEN]
- [UNDEFINED] .( ; "
- [IF]
+ [UNDEFINED] .( [IF] ; "
CODE .( ; "
- MOV #0,&$1DC0
+ MOV #0,&$1DB8
COLON
')' WORD
COUNT TYPE
- $20 $1DC0 !
+ $20 $1DB8 !
; IMMEDIATE
[THEN]
- [UNDEFINED] CR
- [IF]
- DEFER CR
+ [UNDEFINED] CR [IF]
+ CODE CR
+ MOV #$409E,R0
+ ENDCODE
:NONAME
$0D EMIT $0A EMIT
ECHO
+; ----------------------------------------------------------------------------
TESTING interpreter and compiler reading double numbers, with/without prefixes
T{ 1. -> 1 0 }T
T{ $-12AbCdEf. -> -313249263. }T
T{ %10010110. -> 150. }T
T{ %-10010110. -> -150. }T
+; Check BASE is unchanged
T{ BASE @ OLD-DBASE @ = -> TRUE }T
+; Repeat in Hex mode
16 OLD-DBASE ! 16 BASE !
T{ #12346789. -> BC65A5. }T
T{ #-12346789. -> -BC65A5. }T
T{ $-12AbCdEf. -> -12ABCDef. }T
T{ %10010110. -> 96. }T
T{ %-10010110. -> -96. }T
+; Check BASE is unchanged
T{ BASE @ OLD-DBASE @ = -> TRUE }T
DECIMAL
+; Check number prefixes in compile mode
T{ : dnmp #8327. $-2cbe. %011010111. ; dnmp -> 8327. -11454. 215. }T
+; ----------------------------------------------------------------------------
TESTING 2CONSTANT
T{ 1 2 2CONSTANT 2C1 -> }T
T{ 4 5 2CONSTANT 2C3 IMMEDIATE 2C3 -> 4 5 }T
T{ : CD6 2C3 2LITERAL ; CD6 -> 4 5 }T
+; ----------------------------------------------------------------------------
+; Some 2CONSTANTs for the following tests
1SD MAX-INTD 2CONSTANT MAX-2INT
0 MIN-INTD 2CONSTANT MIN-2INT
MAX-2INT 2/ 2CONSTANT HI-2INT
MIN-2INT 2/ 2CONSTANT LO-2INT
+; ----------------------------------------------------------------------------
TESTING DNEGATE
T{ 0. DNEGATE -> 0. }T
T{ MAX-2INT DNEGATE -> MIN-2INT SWAP 1+ SWAP }T
T{ MIN-2INT SWAP 1+ SWAP DNEGATE -> MAX-2INT }T
+; ----------------------------------------------------------------------------
TESTING D+ with small integers
T{ 0. 5. D+ -> 5. }T
T{ HI-2INT MIN-2INT D+ 1. D+ -> LO-2INT }T
T{ LO-2INT 2DUP D+ -> MIN-2INT }T
+; ----------------------------------------------------------------------------
TESTING D- with small integers
T{ 0. 5. D- -> -5. }T
T{ MIN-2INT MIN-2INT D- -> 0. }T
T{ MIN-2INT LO-2INT D- -> LO-2INT }T
+; ----------------------------------------------------------------------------
TESTING D0< D0=
T{ 0. D0< -> FALSE }T
T{ -1. D0= -> FALSE }T
T{ 0 MIN-INTD D0= -> FALSE }T
+; ----------------------------------------------------------------------------
TESTING D2* D2/
T{ 0. D2* -> 0. D2* }T
T{ -1. D2/ -> -1. }T
T{ MIN-2INT D2/ -> LO-2INT }T
+; ----------------------------------------------------------------------------
TESTING D< D=
T{ 0. 1. D< -> TRUE }T
T{ MIN-2INT LO-2INT D= -> FALSE }T
T{ MIN-2INT MAX-2INT D= -> FALSE }T
+; ----------------------------------------------------------------------------
TESTING 2LITERAL 2VARIABLE
T{ : CD3 [ MAX-2INT ] 2LITERAL ; -> }T
T{ : CD7 2V3 [ 2@ ] 2LITERAL ; CD7 -> 5 6 }T
T{ : CD8 [ 6 7 ] 2V3 [ 2! ] ; 2V3 2@ -> 6 7 }T
+; ----------------------------------------------------------------------------
TESTING DMAX DMIN
T{ 1. 2. DMAX -> 2. }T
T{ MIN-2INT 1. DMIN -> MIN-2INT }T
T{ MIN-2INT -1. DMIN -> MIN-2INT }T
+; ----------------------------------------------------------------------------
TESTING D>S DABS
T{ 1234 0 D>S -> 1234 }T
T{ MAX-2INT DABS -> MAX-2INT }T
T{ MIN-2INT 1. D+ DABS -> MAX-2INT }T
+; ----------------------------------------------------------------------------
TESTING M+ M*/
T{ HI-2INT 1 M+ -> HI-2INT 1. D+ }T
T{ MIN-2INT 1 M+ -> MIN-2INT 1. D+ }T
T{ LO-2INT -1 M+ -> LO-2INT -1. D+ }T
+; To correct the result if the division is floored, only used when
+; necessary i.e. negative quotient and remainder <> 0
: ?$8000 [ -3 2 / -2 = ] LITERAL IF 1. D- THEN ;
T{ MAX-2INT LO-2INT NIP DUP NEGATE M*/ -> MAX-2INT DNEGATE }T
T{ MIN-2INT MAX-INTD DUP M*/ -> MIN-2INT }T
+; ----------------------------------------------------------------------------
TESTING D. D.R
+; Create some large double numbers
MAX-2INT 71 73 M*/ 2CONSTANT DBL1
MIN-2INT 73 79 M*/ 2CONSTANT DBL2
;
T{ DOUBLEOUTPUT -> }T
-
+; ----------------------------------------------------------------------------
TESTING 2ROT DU< (Double Number extension words)
T{ 1. 2. 3. 2ROT -> 2. 3. 1. }T
T{ MIN-2INT MAX-2INT DU< -> FALSE }T
T{ MIN-2INT LO-2INT DU< -> TRUE }T
+; ----------------------------------------------------------------------------
TESTING 2VALUE
T{ 1111 2222 2VALUE 2VAL -> }T
T{ : TO-2VAL TO 2VAL ; 5555 6666 TO-2VAL -> }T
T{ 2VAL -> 5555 6666 }T
-
CR .( End of Double-Number word tests) CR
OSDN Git Service
