\ example : POPM #6,IP pop Y,X,W,T,S,IP registers from return stack
\
\ ASSEMBLER conditionnal usage after IF UNTIL WHILE : S< S>= U< U>= 0= 0<> 0>=
-\ ASSEMBLER conditionnal usage before ?JMP ?GOTO : S< S>= U< U>= 0= 0<> 0<
+\ ASSEMBLER conditionnal usage before ?JMP ?GOTO : S< S>= U< U>= 0= 0<> 0<
\
\ FORTH conditionnal : 0= 0< = < > U<
\ first, we test for downloading driver only if UART TERMINAL target
-CODE ABORT_TEST_ASM
-SUB #2,PSP
-MOV TOS,0(PSP)
-MOV &VERSION,TOS
-SUB #308,TOS \ FastForth V3.8
-COLON
-'CR' EMIT \ return to column 1 without 'LF'
-ABORT" FastForth V3.8 please!"
-PWR_STATE \ remove ABORT_TEST_ASM definition before resuming
-;
+ CODE ABORT_TEST_ASM
+ SUB #2,PSP
+ MOV TOS,0(PSP)
+ MOV &VERSION,TOS
+ SUB #309,TOS \ FastForth V3.9
+ COLON
+ 'CR' EMIT \ return to column 1 without 'LF'
+ ABORT" FastForth V3.9 please!"
+ RST_RET \ remove ABORT_TEST_ASM definition before resuming
+ ;
-ABORT_TEST_ASM \ abort test
+ ABORT_TEST_ASM \ abort test
-[UNDEFINED] >R [IF]
+ MARKER {TEST_ASM}
+
+ [UNDEFINED] >R
+ [IF]
\ https://forth-standard.org/standard/core/toR
\ >R x -- R: -- x push to return stack
-CODE >R
-PUSH TOS
-MOV @PSP+,TOS
-MOV @IP+,PC
-ENDCODE
-[THEN]
+ CODE >R
+ PUSH TOS
+ MOV @PSP+,TOS
+ MOV @IP+,PC
+ ENDCODE
+ [THEN]
-[UNDEFINED] R> [IF]
+ [UNDEFINED] R>
+ [IF]
\ https://forth-standard.org/standard/core/Rfrom
\ R> -- x R: x -- pop from return stack ; CALL #RFROM performs DOVAR
-CODE R>
-MOV rDOVAR,PC
-ENDCODE
-[THEN]
+ CODE R>
+ MOV rDOVAR,PC
+ ENDCODE
+ [THEN]
-[UNDEFINED] + [IF]
+ [UNDEFINED] +
+ [IF]
\ https://forth-standard.org/standard/core/Plus
\ + n1/u1 n2/u2 -- n3/u3 add n1+n2
-CODE +
-ADD @PSP+,TOS
-MOV @IP+,PC
-ENDCODE
-[THEN]
+ CODE +
+ ADD @PSP+,TOS
+ MOV @IP+,PC
+ ENDCODE
+ [THEN]
-[UNDEFINED] - [IF]
+ [UNDEFINED] -
+ [IF]
\ https://forth-standard.org/standard/core/Minus
\ - n1/u1 n2/u2 -- n3/u3 n3 = n1-n2
-CODE -
-SUB @PSP+,TOS \ 2 -- n2-n1 ( = -n3)
-XOR #-1,TOS \ 1
-ADD #1,TOS \ 1 -- n3 = -(n2-n1) = n1-n2
-MOV @IP+,PC
-ENDCODE
-[THEN]
+ CODE -
+ SUB @PSP+,TOS \ 2 -- n2-n1 ( = -n3)
+ XOR #-1,TOS \ 1
+ ADD #1,TOS \ 1 -- n3 = -(n2-n1) = n1-n2
+ MOV @IP+,PC
+ ENDCODE
+ [THEN]
-[UNDEFINED] SWAP [IF]
+ [UNDEFINED] SWAP
+ [IF]
\ https://forth-standard.org/standard/core/SWAP
\ SWAP x1 x2 -- x2 x1 swap top two items
-CODE SWAP
-MOV @PSP,W \ 2
-MOV TOS,0(PSP) \ 3
-MOV W,TOS \ 1
-MOV @IP+,PC \ 4
-ENDCODE
-[THEN]
+ CODE SWAP
+ MOV @PSP,W \ 2
+ MOV TOS,0(PSP) \ 3
+ MOV W,TOS \ 1
+ MOV @IP+,PC \ 4
+ ENDCODE
+ [THEN]
-[UNDEFINED] MAX [IF] \ MAX and MIN are defined in {UTILITY}
+ [UNDEFINED] MAX
+ [IF] \ MAX and MIN are defined in {UTILITY}
-CODE MAX \ n1 n2 -- n3 signed maximum
+ CODE MAX \ n1 n2 -- n3 signed maximum
CMP @PSP,TOS \ n2-n1
S< ?GOTO FW1 \ n2<n1
BW1 ADD #2,PSP
MOV @IP+,PC
-ENDCODE
+ ENDCODE
-CODE MIN \ n1 n2 -- n3 signed minimum
+ CODE MIN \ n1 n2 -- n3 signed minimum
CMP @PSP,TOS \ n2-n1
S< ?GOTO BW1 \ n2<n1
FW1 MOV @PSP+,TOS
MOV @IP+,PC
-ENDCODE
+ ENDCODE
-[THEN]
+ [THEN]
-[UNDEFINED] C@ [IF]
+ [UNDEFINED] C@
+ [IF]
\ https://forth-standard.org/standard/core/CFetch
\ C@ c-addr -- char fetch char from memory
-CODE C@
-MOV.B @TOS,TOS
-MOV @IP+,PC
-ENDCODE
-[THEN]
+ CODE C@
+ MOV.B @TOS,TOS
+ MOV @IP+,PC
+ ENDCODE
+ [THEN]
-[UNDEFINED] VARIABLE [IF]
+ [UNDEFINED] VARIABLE
+ [IF]
\ https://forth-standard.org/standard/core/VARIABLE
\ VARIABLE <name> -- define a Forth VARIABLE
-: VARIABLE
-CREATE
-HI2LO
-MOV #$1287,-4(W) \ CFA = CALL rDOVAR
-MOV @RSP+,IP
-MOV @IP+,PC
-ENDCODE
-[THEN]
+ : VARIABLE
+ CREATE
+ HI2LO
+ MOV #$1287,-4(W) \ CFA = CALL rDOVAR
+ MOV @RSP+,IP
+ MOV @IP+,PC
+ ENDCODE
+ [THEN]
-[UNDEFINED] CONSTANT [IF]
+ [UNDEFINED] CONSTANT
+ [IF]
\ https://forth-standard.org/standard/core/CONSTANT
-\ CONSTANT <name> n -- define a Forth CONSTANT
-: CONSTANT
-CREATE
-HI2LO
-MOV TOS,-2(W) \ PFA = n
-MOV @PSP+,TOS
-MOV @RSP+,IP
-MOV @IP+,PC
-ENDCODE
-[THEN]
+\ CONSTANT <name> n -- define a Forth CONSTANT
+ : CONSTANT
+ CREATE
+ HI2LO
+ MOV TOS,-2(W) \ PFA = n
+ MOV @PSP+,TOS
+ MOV @RSP+,IP
+ MOV @IP+,PC
+ ENDCODE
+ [THEN]
-[UNDEFINED] DEFER [IF]
+ [UNDEFINED] DEFER
+ [IF]
\ https://forth-standard.org/standard/core/DEFER
\ DEFER "<spaces>name" --
\Skip leading space delimiters. Parse name delimited by a space.
\name Execution: --
\Execute the xt that name is set to execute, i.e. NEXT (nothing),
\until the phrase ' word IS name is executed, causing a new value of xt to be assigned to name.
-: DEFER
-CREATE
-HI2LO
-MOV #$4030,-4(W) \ CFA = MOV @PC+,PC = BR MOV @IP+,PC
-MOV #NEXT_ADR,-2(W) \ PFA = address of MOV @IP+,PC to do nothing.
-MOV @RSP+,IP
-MOV @IP+,PC
-ENDCODE
-[THEN]
+ : DEFER
+ CREATE
+ HI2LO
+ MOV #$4030,-4(W) \ CFA = MOV @PC+,PC = BR MOV @IP+,PC
+ MOV #NEXT_ADR,-2(W) \ PFA = address of MOV @IP+,PC to do nothing.
+ MOV @RSP+,IP
+ MOV @IP+,PC
+ ENDCODE
+ [THEN]
-[UNDEFINED] >BODY [IF]
+ [UNDEFINED] >BODY
+ [IF]
\ https://forth-standard.org/standard/core/toBODY
\ >BODY -- addr leave BODY of a CREATEd word\ also leave default ACTION-OF primary DEFERred word
-CODE >BODY
-ADD #4,TOS
-MOV @IP+,PC
-ENDCODE
-[THEN]
+ CODE >BODY
+ ADD #4,TOS
+ MOV @IP+,PC
+ ENDCODE
+ [THEN]
-[UNDEFINED] SPACE [IF]
+ [UNDEFINED] SPACE
+ [IF]
\ https://forth-standard.org/standard/core/SPACE
\ SPACE -- output a space
-: SPACE
-$20 EMIT ;
-[THEN]
+ : SPACE
+ $20 EMIT ;
+ [THEN]
-[UNDEFINED] SPACES [IF]
+ [UNDEFINED] SPACES
+ [IF]
\ https://forth-standard.org/standard/core/SPACES
\ SPACES n -- output n spaces
-CODE SPACES
-CMP #0,TOS
-0<> IF
- PUSH IP
- BEGIN
- LO2HI
- $20 EMIT
- HI2LO
- SUB #2,IP
- SUB #1,TOS
- 0= UNTIL
- MOV @RSP+,IP
-THEN
-MOV @PSP+,TOS \ -- drop n
-NEXT
-ENDCODE
-[THEN]
-
-[UNDEFINED] DUP [IF] \ define DUP and ?DUP
+ CODE SPACES
+ CMP #0,TOS
+ 0<> IF
+ PUSH IP
+ BEGIN
+ LO2HI
+ $20 EMIT
+ HI2LO
+ SUB #2,IP
+ SUB #1,TOS
+ 0= UNTIL
+ MOV @RSP+,IP
+ THEN
+ MOV @PSP+,TOS \ -- drop n
+ NEXT
+ ENDCODE
+ [THEN]
+
+ [UNDEFINED] DUP
+ [IF] \ define DUP and ?DUP
\ https://forth-standard.org/standard/core/DUP
\ DUP x -- x x duplicate top of stack
-CODE DUP
+ CODE DUP
BW1 SUB #2,PSP \ 2 push old TOS..
MOV TOS,0(PSP) \ 3 ..onto stack
MOV @IP+,PC \ 4
-ENDCODE
+ ENDCODE
\ https://forth-standard.org/standard/core/qDUP
\ ?DUP x -- 0 | x x DUP if nonzero
-CODE ?DUP
-CMP #0,TOS \ 2 test for TOS nonzero
-0<> ?GOTO BW1 \ 2
-MOV @IP+,PC \ 4
-ENDCODE
-[THEN]
+ CODE ?DUP
+ CMP #0,TOS \ 2 test for TOS nonzero
+ 0<> ?GOTO BW1 \ 2
+ MOV @IP+,PC \ 4
+ ENDCODE
+ [THEN]
-[UNDEFINED] OVER [IF]
+ [UNDEFINED] OVER
+ [IF]
\ https://forth-standard.org/standard/core/OVER
\ OVER x1 x2 -- x1 x2 x1
-CODE OVER
-MOV TOS,-2(PSP) \ 3 -- x1 (x2) x2
-MOV @PSP,TOS \ 2 -- x1 (x2) x1
-SUB #2,PSP \ 1 -- x1 x2 x1
-MOV @IP+,PC
-ENDCODE
-[THEN]
+ CODE OVER
+ MOV TOS,-2(PSP) \ 3 -- x1 (x2) x2
+ MOV @PSP,TOS \ 2 -- x1 (x2) x1
+ SUB #2,PSP \ 1 -- x1 x2 x1
+ MOV @IP+,PC
+ ENDCODE
+ [THEN]
+
+ [UNDEFINED] U.R
+ [IF] \ defined in {UTILITY}
+ : U.R \ u n -- display u unsigned in n width (n >= 2)
+ >R <# 0 # #S #>
+ R> OVER - 0 MAX SPACES TYPE
+ ;
+ [THEN]
+
+\ https://forth-standard.org/standard/core/IF
+\ IF -- IFadr initialize conditional forward branch
+ [UNDEFINED] IF
+ [IF] \ define IF THEN
+
+ CODE IF
+ SUB #2,PSP \
+ MOV TOS,0(PSP) \
+ MOV &DP,TOS \ -- HERE
+ ADD #4,&DP \ compile one word, reserve one word
+ MOV #QFBRAN,0(TOS) \ -- HERE compile QFBRAN
+ ADD #2,TOS \ -- HERE+2=IFadr
+ MOV @IP+,PC
+ ENDCODE IMMEDIATE
-[UNDEFINED] U.R [IF] \ defined in {UTILITY}
-: U.R \ u n -- display u unsigned in n width (n >= 2)
- >R <# 0 # #S #>
- R> OVER - 0 MAX SPACES TYPE
-;
-[THEN]
+\ https://forth-standard.org/standard/core/THEN
+\ THEN IFadr -- resolve forward branch
+ CODE THEN
+ MOV &DP,0(TOS) \ -- IFadr
+ MOV @PSP+,TOS \ --
+ MOV @IP+,PC
+ ENDCODE IMMEDIATE
+ [THEN]
+
+\ https://forth-standard.org/standard/core/SWAP
+\ SWAP x1 x2 -- x2 x1 swap top two items
+ [UNDEFINED] SWAP
+ [IF]
+ CODE SWAP
+ PUSH TOS \ 3
+ MOV @PSP,TOS \ 2
+ MOV @RSP+,0(PSP) \ 4
+ MOV @IP+,PC \ 4
+ ENDCODE
+ [THEN]
+
+\ https://forth-standard.org/standard/core/BEGIN
+\ BEGIN -- BEGINadr initialize backward branch
+ [UNDEFINED] BEGIN
+ [IF] \ define BEGIN UNTIL AGAIN WHILE REPEAT
+
+ CODE BEGIN
+ MOV #HEREXEC,PC
+ ENDCODE IMMEDIATE
+
+\ https://forth-standard.org/standard/core/UNTIL
+\ UNTIL BEGINadr -- resolve conditional backward branch
+ CODE UNTIL
+ MOV #QFBRAN,X
+BW1 ADD #4,&DP \ compile two words
+ MOV &DP,W \ W = HERE
+ MOV X,-4(W) \ compile Bran or QFBRAN at HERE
+ MOV TOS,-2(W) \ compile bakcward adr at HERE+2
+ MOV @PSP+,TOS
+ MOV @IP+,PC
+ ENDCODE IMMEDIATE
+
+\ https://forth-standard.org/standard/core/AGAIN
+\ AGAIN BEGINadr -- resolve uncondionnal backward branch
+ CODE AGAIN
+ MOV #BRAN,X
+ GOTO BW1
+ ENDCODE IMMEDIATE
+
+\ https://forth-standard.org/standard/core/WHILE
+\ WHILE BEGINadr -- WHILEadr BEGINadr
+ : WHILE
+ POSTPONE IF SWAP
+ ; IMMEDIATE
+
+\ https://forth-standard.org/standard/core/REPEAT
+\ REPEAT WHILEadr BEGINadr -- resolve WHILE loop
+ : REPEAT
+ POSTPONE AGAIN POSTPONE THEN
+ ; IMMEDIATE
+ [THEN]
+
+ [UNDEFINED] DO
+ [IF] \ define DO LOOP +LOOP
-[UNDEFINED] DO [IF]
\ https://forth-standard.org/standard/core/DO
\ DO -- DOadr L: -- 0
-CODE DO \ immediate
-SUB #2,PSP \
-MOV TOS,0(PSP) \
-ADD #2,&DP \ make room to compile xdo
-MOV &DP,TOS \ -- HERE+2
-MOV #XDO,-2(TOS) \ compile xdo
-ADD #2,&LEAVEPTR \ -- HERE+2 LEAVEPTR+2
-MOV &LEAVEPTR,W \
-MOV #0,0(W) \ -- HERE+2 L-- 0
-MOV @IP+,PC
-ENDCODE IMMEDIATE
-[THEN]
+ HDNCODE XDO \ DO run time
+ MOV #$8000,X \ 2 compute 8000h-limit = "fudge factor"
+ SUB @PSP+,X \ 2
+ MOV TOS,Y \ 1 loop ctr = index+fudge
+ ADD X,Y \ 1 Y = INDEX
+ PUSHM #2,X \ 4 PUSHM X,Y, i.e. PUSHM LIMIT, INDEX
+ MOV @PSP+,TOS \ 2
+ MOV @IP+,PC \ 4
+ ENDCODE
+
+ CODE DO
+ SUB #2,PSP \
+ MOV TOS,0(PSP) \
+ ADD #2,&DP \ make room to compile xdo
+ MOV &DP,TOS \ -- HERE+2
+ MOV #XDO,-2(TOS) \ compile xdo
+ ADD #2,&LEAVEPTR \ -- HERE+2 LEAVEPTR+2
+ MOV &LEAVEPTR,W \
+ MOV #0,0(W) \ -- HERE+2 L-- 0, init
+ MOV @IP+,PC
+ ENDCODE IMMEDIATE
-[UNDEFINED] LOOP [IF]
\ https://forth-standard.org/standard/core/LOOP
\ LOOP DOadr -- L-- an an-1 .. a1 0
-CODE LOOP \ immediate
+ HDNCODE XLOOP \ LOOP run time
+ ADD #1,0(RSP) \ 4 increment INDEX
+BW1 BIT #$100,SR \ 2 is overflow bit set?
+ 0= IF \ branch if no overflow
+ MOV @IP,IP
+ MOV @IP+,PC
+ THEN
+ ADD #4,RSP \ 1 empties RSP
+ ADD #2,IP \ 1 overflow = loop done, skip branch ofs
+ MOV @IP+,PC \ 4 14~ taken or not taken xloop/loop
+ ENDCODE \
+
+ CODE LOOP
MOV #XLOOP,X
-BW1 ADD #4,&DP \ make room to compile two words
+BW2 ADD #4,&DP \ make room to compile two words
MOV &DP,W
MOV X,-4(W) \ xloop --> HERE
MOV TOS,-2(W) \ DOadr --> HERE+2
-BEGIN \ resolve all "leave" adr
- MOV &LEAVEPTR,TOS \ -- Adr of top LeaveStack cell
- SUB #2,&LEAVEPTR \ --
- MOV @TOS,TOS \ -- first LeaveStack value
- CMP #0,TOS \ -- = value left by DO ?
-0<> WHILE
- MOV W,0(TOS) \ move adr after loop as UNLOOP adr
-REPEAT
+ BEGIN \ resolve all "leave" adr
+ MOV &LEAVEPTR,TOS \ -- Adr of top LeaveStack cell
+ SUB #2,&LEAVEPTR \ --
+ MOV @TOS,TOS \ -- first LeaveStack value
+ CMP #0,TOS \ -- = value left by DO ?
+ 0<> WHILE
+ MOV W,0(TOS) \ move adr after loop as UNLOOP adr
+ REPEAT
MOV @PSP+,TOS
MOV @IP+,PC
-ENDCODE IMMEDIATE
-[THEN]
+ ENDCODE IMMEDIATE
-[UNDEFINED] +LOOP [IF]
\ https://forth-standard.org/standard/core/PlusLOOP
\ +LOOP adrs -- L-- an an-1 .. a1 0
-CODE +LOOP \ immediate
-MOV #XPLOOP,X
-GOTO BW1
-ENDCODE IMMEDIATE
-[THEN]
-
-[UNDEFINED] I [IF]
+ HDNCODE XPLOO \ +LOOP run time
+ ADD TOS,0(RSP) \ 4 increment INDEX by TOS value
+ MOV @PSP+,TOS \ 2 get new TOS, doesn't change flags
+ GOTO BW1 \ 2
+ ENDCODE \
+
+ CODE +LOOP
+ MOV #XPLOO,X
+ GOTO BW2
+ ENDCODE IMMEDIATE
+ [THEN]
+
+ [UNDEFINED] I
+ [IF]
\ https://forth-standard.org/standard/core/I
\ I -- n R: sys1 sys2 -- sys1 sys2
\ get the innermost loop index
-CODE I
-SUB #2,PSP \ 1 make room in TOS
-MOV TOS,0(PSP) \ 3
-MOV @RSP,TOS \ 2 index = loopctr - fudge
-SUB 2(RSP),TOS \ 3
-MOV @IP+,PC \ 4 13~
-ENDCODE
-[THEN]
-
-[UNDEFINED] DUMP [IF] \ defined in {UTILITY}
+ CODE I
+ SUB #2,PSP \ 1 make room in TOS
+ MOV TOS,0(PSP) \ 3
+ MOV @RSP,TOS \ 2 index = loopctr - fudge
+ SUB 2(RSP),TOS \ 3
+ MOV @IP+,PC \ 4 13~
+ ENDCODE
+ [THEN]
+
+\ https://forth-standard.org/standard/core/BASE
+\ BASE -- a-addr holds conversion radix
+ [UNDEFINED] BASE
+ [IF]
+ BASEADR CONSTANT BASE
+ [THEN]
+
+\ https://forth-standard.org/standard/core/CR
+\ CR -- send CR+LF to the output device
+ [UNDEFINED] CR
+ [IF]
+ DEFER CR \ DEFERed definition, by default executes that of :NONAME
+
+ :NONAME
+ 'CR' EMIT 'LF' EMIT
+ ; IS CR
+ [THEN]
+
+ [UNDEFINED] DUMP
+ [IF] \ defined in {UTILITY}
\ https://forth-standard.org/standard/tools/DUMP
-CODE DUMP \ adr n -- dump memory
-PUSH IP
-PUSH &BASEADR \ save current base
-MOV #$10,&BASEADR \ HEX base
-ADD @PSP,TOS \ -- ORG END
-LO2HI
- SWAP \ -- END ORG
- DO CR \ generate line
- I 4 U.R SPACE \ generate address
- I 8 + I
- DO I C@ 3 U.R LOOP
- SPACE
- I $10 + I 8 +
- DO I C@ 3 U.R LOOP
- SPACE SPACE
- I $10 + I \ display 16 chars
- DO I C@ $7E MIN $20 MAX EMIT LOOP
- $10 +LOOP
- R> BASEADR ! \ restore current base
-;
-[THEN]
+ CODE DUMP \ adr n -- dump memory
+ PUSH IP
+ PUSH &BASE \ save current base
+ MOV #$10,&BASEADR \ HEX base
+ ADD @PSP,TOS \ -- ORG END
+ LO2HI
+ SWAP \ -- END ORG
+ DO CR \ generate line
+ I 4 U.R SPACE \ generate address
+ I 8 + I
+ DO I C@ 3 U.R LOOP
+ SPACE
+ I $10 + I 8 +
+ DO I C@ 3 U.R LOOP
+ SPACE SPACE
+ I $10 + I \ display 16 chars
+ DO I C@ $7E MIN $20 MAX EMIT LOOP
+ $10 +LOOP
+ R> BASE ! \ restore current base
+ ;
+ [THEN]
\ -----------------------------------------------------------------------
\ test CPUx instructions PUSHM, POPM, RLAM, RRAM, RRCM, RRUM
\ -----------------------------------------------------------------------
-CODE TESTPUSHM
+ CODE TESTPUSHM
BW1
-\ PUSHM #16,R14 \ uncomment to test error "out of bounds"
-\ PUSHM #2,R0 \ uncomment to test error "out of bounds"
-\ PUSHM #0,IP \ uncomment to test error "out of bounds"
-\ POPM #17,R15 \ uncomment to test error "out of bounds"
-\ POPM #2,R0 \ uncomment to test error "out of bounds"
-\ POPM #0,IP \ uncomment to test error "out of bounds"
- MOV #22222,Y
- MOV #3,X
- MOV #2,W
- MOV #1,T
- MOV #0,S
-
- PUSHM #4,IP \ PUSHM IP,S,T,W
- POPM #4,IP \ POPM W,T,S,IP
- SUB #10,PSP
- MOV TOS,8(PSP) \ save old TOS
- MOV S,6(PSP)
- MOV T,4(PSP)
- MOV W,2(PSP)
- MOV X,0(PSP)
- MOV Y,TOS
-\ RLAM #0,TOS \ uncomment to test error "out of bounds"
-\ RLAM #5,TOS \ uncomment to test error "out of bounds"
- RRAM #1,TOS \ 0 < shift value < 5
- RLAM #2,TOS
- RRCM #1,TOS
- RRUM #1,TOS
- COLON \ high level part of the word starts here...
- space . . . . .
- ; \ and finishes here.
- \
-TESTPUSHM ; you should see 11111 3 2 1 0 -->
-
-CODE TESTPOPM
+\ PUSHM #16,R14 \ uncomment to test error "out of bounds"
+\ PUSHM #2,R0 \ uncomment to test error "out of bounds"
+\ PUSHM #0,IP \ uncomment to test error "out of bounds"
+\ POPM #17,R15 \ uncomment to test error "out of bounds"
+\ POPM #2,R0 \ uncomment to test error "out of bounds"
+\ POPM #0,IP \ uncomment to test error "out of bounds"
+ MOV #22222,Y
+ MOV #3,X
+ MOV #2,W
+ MOV #1,T
+ MOV #0,S
+
+ PUSHM #4,IP \ PUSHM IP,S,T,W
+ POPM #4,IP \ POPM W,T,S,IP
+ SUB #10,PSP
+ MOV TOS,8(PSP) \ save old TOS
+ MOV S,6(PSP)
+ MOV T,4(PSP)
+ MOV W,2(PSP)
+ MOV X,0(PSP)
+ MOV Y,TOS
+\ RLAM #0,TOS \ uncomment to test error "out of bounds"
+\ RLAM #5,TOS \ uncomment to test error "out of bounds"
+ RRAM #1,TOS \ 0 < shift value < 5
+ RLAM #2,TOS
+ RRCM #1,TOS
+ RRUM #1,TOS
+ COLON \ high level part of the word starts here...
+ space . . . . .
+ ; \ and finishes here.
+
+ TESTPUSHM ; you should see 11111 3 2 1 0 -->
+
+ CODE TESTPOPM
GOTO BW1 \ JMP TESTPUSHM
-ENDCODE
+ ENDCODE
- \
-TESTPOPM ; you should see 11111 3 2 1 0 -->
+ TESTPOPM ; you should see 11111 3 2 1 0 -->
\ test symbolic branch in assembler
\ test a FORTH section encapsulated in an assembly word
\ -----------------------------------------------------------------------
-CODE TEST1 \ the word "CODE" add ASSEMBLER as CONTEXT vocabulary...
-
- MOV &BASEADR,&BASEADR \ to test &xxxx src operand
- CMP #%10,&BASEADR
-0<> IF MOV #2,&BASEADR \ if base <> 2
-ELSE MOV #$0A,&BASEADR \ else base = 2
-THEN
- COLON \ tips : no "ok" displayed in start of line <==> compilation mode
- BASEADR @ U. \ always display 10 !
- ;
+ CODE TEST1 \ the word "CODE" add ASSEMBLER as CONTEXT vocabulary...
+
+ MOV &BASE,&BASE \ to test &xxxx src operand
+ CMP #%10,&BASE
+ 0<> IF MOV #2,&BASE \ if base <> 2
+ ELSE MOV #$0A,&BASE \ else base = 2
+ THEN
+ COLON \ tips : no "ok" displayed in start of line <==> compilation mode
+ BASE @ U. \ always display 10 !
+ ;
\
\ -----------------------------------------------------------------------
\ test a word that starts as word FORTH and ends as assembly word
\ -----------------------------------------------------------------------
-: TEST2 \ ":" starts compilation
- BASEADR @ U. \ always display 10 !
- HI2LO \ switch FORTH to ASM : compile one word (next address)
- \ add vocabulary ASSEMBLER as CONTEXT vocabulary
- \ switch in interpret mode
- CMP #2, &BASEADR
-0<> IF MOV #2, &BASEADR \ if variable system BASE <> 2
-ELSE MOV #10,&BASEADR \ else (BASE = 2)
-THEN
-\ MOV #EXIT,PC \ to pair with ":" i.e. to restore IP saved by : then execute NEXT.
+ : TEST2 \ ":" starts compilation
+ BASE @ U. \ always display 10 !
+ HI2LO \ switch FORTH to ASM : compile one word (next address)
+ \ add vocabulary ASSEMBLER as CONTEXT vocabulary
+ \ switch in interpret mode
+ CMP #2, &BASE
+ 0<> IF MOV #2, &BASE \ if variable system BASE <> 2
+ ELSE MOV #10,&BASE \ else (BASE = 2)
+ THEN
+\ MOV #EXIT,PC \ to pair with ":" i.e. to restore IP saved by : then execute NEXT.
\ but even compile two words, it's better to compile an inline EXIT :
- MOV @RSP+,IP \ restore IP
- MOV @IP+,PC \ = NEXT
-ENDCODE \ ends assembler : remove vocabulary ASSEMBLER from CONTEXT
- \
+ MOV @RSP+,IP \ restore IP
+ MOV @IP+,PC \ = NEXT
+ ENDCODE \ ends assembler : remove vocabulary ASSEMBLER from CONTEXT
+\
\ -----------------------------------------------------------------------
\ test a word that starts as assembly word and ends as FORTH word
\ -----------------------------------------------------------------------
-CODE TEST3 \ "CODE" starts assembler, i.e. add ASSEMBLER as CONTEXT vocabulary
- CMP #2, &BASEADR
-0<> IF MOV #2, &BASEADR \ if variable system BASE <> 2
-ELSE MOV #10,&BASEADR \ else (BASE = 2)
-THEN COLON \
- BASEADR @ U. \ always display 10 !
-; \
- \
+ CODE TEST3 \ "CODE" starts assembler, i.e. add ASSEMBLER as CONTEXT vocabulary
+ CMP #2, &BASE
+ 0<> IF MOV #2, &BASE \ if variable system BASE <> 2
+ ELSE MOV #10,&BASE \ else (BASE = 2)
+ THEN COLON \
+ BASE @ U. \ always display 10 !
+ ; \
+\
\ -----------------------------------------------------------------------
HI2LO
CMP #0,TOS
0= UNTIL MOV @PSP+,TOS
-\ MOV #EXIT,PC \ to pair with ":" i.e. to restore IP saved by : then execute NEXT.
+\ MOV #EXIT,PC \ to pair with ":" i.e. to restore IP saved by : then execute NEXT.
MOV @RSP+,IP \ restore IP
MOV @IP+,PC \ = NEXT
ENDCODE
[THEN]
: BYTES_TABLE_IDX
-CREATE
+CREATE
0 DO I C,
LOOP
DOES>
CODE IDX_TEST1 \ index -- value
MOV.B BYTES_TABLE1(TOS),TOS \ -- value
COLON
- U.
-;
+ U.
+;
0 IDX_TEST1 ; you should see 1 -->
\ -----------------------------------------------------------------------
-\ tests access to a CREATED word with assembler
+\ tests access to a CREATED word with assembler
\ -----------------------------------------------------------------------
TABLE 2 - CONSTANT PFA_TABLE \ PFA_TABLE leave the PFA of TABLE
-CODE REDIRECT ; <table> -- redirects TABLE to argument <table>
+CODE REDIRECT ; <table> -- redirects TABLE to argument <table>
MOV TOS,&PFA_TABLE
MOV @PSP+,TOS
MOV @IP+,PC
ENDCODE
\
-CODE REDIRECT0 ; -- redirects TABLE to TABLE0
+CODE REDIRECT0 ; -- redirects TABLE to TABLE0
MOV #TABLE0,&PFA_TABLE
MOV @IP+,PC
ENDCODE
\
-CODE REDIRECT10 ; -- redirects TABLE to TABLE10
+CODE REDIRECT10 ; -- redirects TABLE to TABLE10
MOV #TABLE10,&PFA_TABLE
MOV @IP+,PC
ENDCODE
\
-CODE REDIRECT20 ; -- redirects TABLE to TABLE20
+CODE REDIRECT20 ; -- redirects TABLE to TABLE20
MOV #TABLE20,&PFA_TABLE
MOV @IP+,PC
ENDCODE
\
\ -----------------------------------------------------------------------
-\ tests behaviour of assembly error
+\ tests behaviour of assembly error
\ -----------------------------------------------------------------------
\ R16 causes an error, assembler context is aborted and the word TEST7 is "hidden".
DEFER TRUC ; here, TRUC is a secondary DEFERred word (i.e. without BODY)
- \
-CODENNM ; leaves its execution address (CFA) on stack
+CODENNM ; does DUP
SUB #2,PSP
MOV TOS,0(PSP)
MOV @IP+,PC
-ENDCODE
+ENDCODE ; leaves its execution address (CFA) on stack
DUP .
TRUC . ; display TOS value -->
-' TRUC >BODY IS TRUC ; TRUC is reinitialzed with its default action
+\ ' DROP IS TRUC ; TRUC is redirected to DROP
+\
+\ TRUC ; The generated error displays stack empty! in reverse video, removes the TRUC definition and restarts the interpretation after the end of the file. And as you see, FastForth is able to display long lines, interesting, doesn't it? -->
+\
+
+' TRUC >BODY IS TRUC ; TRUC is reinitialized with its default action
-TRUC . ; display TOS value -->
+TRUC . ; display TOS value -->
-\ ' DROP IS TRUC ; TRUC is redirected to DROP
-\
-\ TRUC ; The generated error displays stack empty! in reverse video, removes the TRUC definition and restarts the interpretation after the end of the file. And as you see, FastForth is able to display long lines, interesting, doesn't it? -->
-\
\ bla
\ bla
\ bla
-\
-\
-\
-\
-\
-\
-\
+\
+\
+\
+\
+\
+\
+\
\ bla
\ ...
OSDN Git Service
