\ ASSEMBLER conditionnal usage with ?JMP ?GOTO S< S>= U< U>= 0= 0<> 0<
-PWR_STATE
-
-[UNDEFINED] {CORDIC} [IF]
-
-[UNDEFINED] MARKER [IF]
-\ https://forth-standard.org/standard/core/MARKER
-\ MARKER
-\ ( "<spaces>name" -- )
-\ Skip leading space delimiters. Parse name delimited by a space. Create a definition for name
-\ with the execution semantics defined below.
-\
-\ name Execution: ( -- )
-\ Restore all dictionary allocation and search order pointers to the state they had just prior to the
-\ definition of name. Remove the definition of name and all subsequent definitions. Restoration
-\ of any structures still existing that could refer to deleted definitions or deallocated data space is
-\ not necessarily provided. No other contextual information such as numeric base is affected
-\
-: MARKER
-CREATE
-HI2LO
-MOV &LASTVOC,0(W) \ [BODY] = LASTVOC
-SUB #2,Y \ 1 Y = LFA
-MOV Y,2(W) \ 3 [BODY+2] = LFA = DP to be restored
-ADD #4,&DP \ 3 add 2 cells
-LO2HI
-DOES>
-HI2LO
-MOV @RSP+,IP \ -- PFA
-MOV @TOS+,&INIVOC \ set VOC_LINK value for RST_STATE
-MOV @TOS,&INIDP \ set DP value for RST_STATE
-MOV @PSP+,TOS \ --
-MOV #RST_STATE,PC \ execute RST_STATE, PWR_STATE then STATE_DOES
-ENDCODE
-[THEN]
+[DEFINED] {CORDIC} [IF] {CORDIC} [THEN]
MARKER {CORDIC}
-[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]
-[UNDEFINED] IF [IF]
-\ https://forth-standard.org/standard/core/IF
-\ IF -- IFadr initialize conditional forward branch
-CODE IF \ immediate
-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
-[THEN]
-
-[UNDEFINED] THEN [IF]
-\ https://forth-standard.org/standard/core/THEN
-\ THEN IFadr -- resolve forward branch
-CODE THEN \ immediate
-MOV &DP,0(TOS) \ -- IFadr
-MOV @PSP+,TOS \ --
-MOV @IP+,PC
-ENDCODE IMMEDIATE
-[THEN]
-
-[UNDEFINED] ELSE [IF]
-\ https://forth-standard.org/standard/core/ELSE
-\ ELSE IFadr -- ELSEadr resolve forward IF branch, leave ELSEadr on stack
-CODE ELSE \ immediate
-ADD #4,&DP \ make room to compile two words
-MOV &DP,W \ W=HERE+4
-MOV #BRAN,-4(W)
-MOV W,0(TOS) \ HERE+4 ==> [IFadr]
-SUB #2,W \ HERE+2
-MOV W,TOS \ -- ELSEadr
-MOV @IP+,PC
-ENDCODE IMMEDIATE
-[THEN]
-
-[UNDEFINED] BEGIN [IF]
-\ https://forth-standard.org/standard/core/BEGIN
-\ BEGIN -- BEGINadr initialize backward branch
-CODE BEGIN \ immediate
-MOV #HERE,PC \ BR HERE
-ENDCODE IMMEDIATE
-[THEN]
+\ CORDIC USES
+\ OPERATION | MODE | INITIALIZE x y z | DIRECTION | RESULT | post operation
+\ --------------|-----------|-----------------------|---------------|-------------------|
+\ sine, cosine | Rotation | x=1, y=0, z=angle | Reduce z to 0 | cos=x*Gi,sin=y*Gi | mutiply by 1/Gi
+\ --------------|-----------|-----------------------|---------------|-------------------|
+\ Polar to Rect | Rotation | x=magnit, y=0, Z=angle| Reduce z to 0 | X=x*Gi, Y=y*Gi | mutiply by 1/Gi
+\ --------------|-----------|-----------------------|---------------|-------------------|
+\ Rotation | Rotation | x=X, y=Y, z=angle | Reduce z to 0 | X'=x*Gi,Y'=y*Gi | <=== not implemented
+\ --------------|-----------|-----------------------|---------------|-------------------|
+\ Rect to Polar | Vector | x=X, y=Y, z=0 | Reduce y to 0 | hyp=x*Gi, angle=z | mutiply hyp by 1/Gi
+\ --------------|-----------|-----------------------|---------------|-------------------|
+\ Gi = CORDIC gain for i iterations; Gi < 1
+\
-[UNDEFINED] UNTIL [IF]
-\ https://forth-standard.org/standard/core/UNTIL
-\ UNTIL BEGINadr -- resolve conditional backward branch
-CODE UNTIL \ immediate
- 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
-[THEN]
+CREATE T_ARCTAN \ ArcTan table
+11520 , \ 256 * 45
+6801 , \ 256 * 26.565
+3593 , \ 256 * 14.036
+1824 , \ 256 * 7.125
+916 , \ 256 * 3.576
+458 , \ 256 * 1.790
+229 , \ 256 * 0.895
+115 , \ 256 * 0.448
+57 , \ 256 * 0.224
+29 , \ 256 * 0.112
+14 , \ 256 * 0.056
+7 , \ 256 * 0.028
+4 , \ 256 * 0.014
+2 , \ 256 * 0.007
+1 , \ 256 * 0.003
-[UNDEFINED] AGAIN [IF]
-\ https://forth-standard.org/standard/core/AGAIN
-\ AGAIN BEGINadr -- resolve uncondionnal backward branch
-CODE AGAIN \ immediate
-MOV #BRAN,X
-GOTO BW1
-ENDCODE IMMEDIATE
-[THEN]
+CREATE T_SCALE \ 1/Gi table
+46340 , \ = 65536 * cos(45)
+41448 , \ = 65536 * cos(45) * cos(26.565)
+40211 , \ = 65536 * cos(45) * cos(26.565) * cos(14.036)
+39900 , \ = 65536 * cos(45) * cos(26.565) * cos(14.036) * ...
+39822 ,
+39803 ,
+39798 ,
+39797 ,
+39797 ,
+39797 ,
+39797 ,
+39797 ,
+39797 ,
+39797 ,
+39797 ,
-[UNDEFINED] WHILE [IF]
-\ https://forth-standard.org/standard/core/WHILE
-\ WHILE BEGINadr -- WHILEadr BEGINadr
-: WHILE \ immediate
-POSTPONE IF SWAP
-; IMMEDIATE
+[UNDEFINED] @ [IF]
+\ https://forth-standard.org/standard/core/Fetch
+\ @ c-addr -- char fetch char from memory
+CODE @
+MOV @TOS,TOS
+MOV @IP+,PC
+ENDCODE
[THEN]
-[UNDEFINED] REPEAT [IF]
-\ https://forth-standard.org/standard/core/REPEAT
-\ REPEAT WHILEadr BEGINadr -- resolve WHILE loop
-: REPEAT
-POSTPONE AGAIN POSTPONE THEN
-; IMMEDIATE
+[UNDEFINED] R> [IF]
+\ https://forth-standard.org/standard/core/Rfrom
+\ R> -- x R: x -- pop from return stack ; CALL #RFROM performs DOVAR
+CODE R>
+SUB #2,PSP \ 1
+MOV TOS,0(PSP) \ 3
+MOV @RSP+,TOS \ 2
+MOV @IP+,PC \ 4
+ENDCODE
[THEN]
-[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
+[UNDEFINED] = [IF]
+\ https://forth-standard.org/standard/core/Equal
+\ = x1 x2 -- flag test x1=x2
+CODE =
+SUB @PSP+,TOS \ 2
+0<> IF \ 2
+ AND #0,TOS \ 1
+ MOV @IP+,PC \ 4
+THEN
+XOR #-1,TOS \ 1 flag Z = 1
+MOV @IP+,PC \ 4
+ENDCODE
[THEN]
-[UNDEFINED] LOOP [IF]
-\ https://forth-standard.org/standard/core/LOOP
-\ LOOP DOadr -- L-- an an-1 .. a1 0
-CODE LOOP \ immediate
- MOV #XLOOP,X
- 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
- MOV @PSP+,TOS
- MOV @IP+,PC
-ENDCODE IMMEDIATE
+\ https://forth-standard.org/standard/core/Uless
+\ U< u1 u2 -- flag test u1<u2, unsigned
+[UNDEFINED] U< [IF]
+CODE U<
+SUB @PSP+,TOS \ 2 u2-u1
+0<> IF
+ MOV #-1,TOS \ 1
+ U< IF \ 2 flag
+ AND #0,TOS \ 1 flag Z = 1
+ THEN
+THEN
+MOV @IP+,PC \ 4
+ENDCODE
[THEN]
-
-[UNDEFINED] {FIXPOINT} [IF] \ define words to display angle as Q15.16 number.
-
[UNDEFINED] DABS [IF]
\ https://forth-standard.org/standard/double/DABS
\ DABS d1 -- |d1| absolute value
CODE DABS
AND #-1,TOS \ clear V, set N
-S< IF \ if positive (N=0)
+S< IF \
XOR #-1,0(PSP) \ 4
XOR #-1,TOS \ 1
ADD #1,0(PSP) \ 4
ENDCODE
[THEN]
+[UNDEFINED] HOLDS [IF]
\ https://forth-standard.org/standard/core/HOLDS
\ Adds the string represented by addr u to the pictured numeric output string
\ compilation use: <# S" string" HOLDS #>
-\ free chars area in the 32+2 bytes HOLD buffer sized for a 32 bits {hexa,decimal,binary} number = {26,23,2}.
+\ free chars area in the 32+2 bytes HOLD buffer = {26,23,2} chars with a 32 bits sized {hexa,decimal,binary} number.
\ (2 supplementary bytes are room for sign - and decimal point)
\ C HOLDS addr u --
CODE HOLDS
-BW1 MOV @PSP+,X \ 2
- ADD TOS,X \ 1 src
- MOV &HP,Y \ 3 dst
-BEGIN SUB #1,X \ 1 src-1
- SUB #1,TOS \ 1 cnt-1
-U>= WHILE SUB #1,Y \ 1 dst-1
- MOV.B @X,0(Y) \ 4
-REPEAT MOV Y,&HP \ 3
- MOV @PSP+,TOS \ 2
- MOV @IP+,PC \ 4 15 words
+ MOV @PSP+,X \ 2 X=src
+BW3 ADD TOS,X \ 1 X=src_end
+ MOV &HP,Y \ 3 Y=dst
+BEGIN SUB #1,X \ 1 src-1
+ SUB #1,TOS \ 1 cnt-1
+U>= WHILE SUB #1,Y \ 1 dst-1
+ MOV.B @X,0(Y) \ 4
+REPEAT MOV Y,&HP \ 3
+ MOV @PSP+,TOS \ 2
+ MOV @IP+,PC \ 4 15 words
ENDCODE
+[THEN]
+
+DEVICEID @ $81F3 U<
+$81EF DEVICEID @ U<
+= [IF] ; MSP430FR413x subfamily without hardware_MPY
-\ F#S Qlo Qhi u -- Qhi 0 convert fractionnal part of Q15.16 fixed point number with u digits
+[UNDEFINED] F#S [IF]
+\ F#S Qlo Qhi len -- Qhi 0 convert fractional part Qlo of Q15.16 fixed point number
+\ with len digits
CODE F#S
- MOV 2(PSP),X \ -- Qlo Qhi u X = Qlo
- MOV @PSP,2(PSP) \ -- Qhi Qhi u
- MOV X,0(PSP) \ -- Qhi Qlo u
- MOV TOS,T \ T = limit
- MOV #0,S \ S = count
-BEGIN MOV @PSP,&MPY \ Load 1st operand
- MOV &BASEADR,&OP2 \ Load 2nd operand
- MOV &RES0,0(PSP) \ -- Qhi RESlo x low result on stack
- MOV &RES1,TOS \ -- Qhi RESlo REShi high result in TOS
- CMP #10,TOS \ digit to char
+ MOV @PSP,S \ -- Qlo Qhi len S = Qhi
+ MOV #0,T \ T = count
+ PUSHM #3,IP \ R-- IP Qhi count
+ MOV 2(PSP),0(PSP) \ -- Qlo Qlo len
+ MOV TOS,2(PSP) \ -- len Qlo len
+BEGIN MOV &BASEADR,TOS \ -- len Qlo base
+ LO2HI
+ UM* \ u1 u2 -- RESlo REShi
+ HI2LO \ -- len RESlo digit
+ CMP #10,TOS \ digit to char
U>= IF ADD #7,TOS
- THEN ADD #$30,TOS
- MOV.B TOS,HOLDS_ORG(S) \ -- Qhi RESlo char char to string
- ADD #1,S \ count+1
- CMP T,S \ count=limit ?
-0= UNTIL MOV #0,0(PSP) \ -- Qhi 0 REShi
- MOV T,TOS \ -- Qhi 0 limit
- SUB #2,PSP \ -- Qhi 0 x len
- MOV #HOLDS_ORG,0(PSP) \ -- Qhi 0 addr len
- GOTO BW1 \ JMP HOLDS
+ THEN ADD #$30,TOS \ -- len RESlo char
+ MOV @RSP,T \ T=count
+ MOV.B TOS,HOLDS_ORG(T) \ char to string_org(T)
+ ADD #1,T \ count+1
+ MOV T,0(RSP) \
+ CMP 2(PSP),T \ -- len RESlo char count=len ?
+U>= UNTIL POPM #3,IP \ S=Qhi, T=len
+ MOV T,TOS \ -- len RESlo len
+ MOV S,2(PSP) \ -- Qhi RESlo len
+ MOV #0,0(PSP) \ -- Qhi 0 len
+ MOV #HOLDS_ORG,X \ -- Qhi 0 len X=HOLDS_ORG
+ GOTO BW3 \ 36~ JMP HOLDS
ENDCODE
+[THEN]
-[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
+ASM XSCALE \ X = X*Cordic_Gain
+SUB #4,PSP
+MOV TOS,2(PSP)
+MOV X,0(PSP) \ 1st operand = X
+MOV T_SCALE(W),TOS \ 3 2nd operand = CORDIC Gain * 65536 ; IS UNSIGNED!
+\ https://forth-standard.org/standard/core/MTimes
+\ M* n1 n2 -- dlo dhi signed 16*16->32 multiply
+\ -----------------------------------------------
+\ CODE M*
+\ -----------------------------------------------
+MOV @PSP,S \ S= n1
+CMP #0,S \ n1 > -1 ?
+S< IF
+ XOR #-1,0(PSP) \ n1 --> u1
+ ADD #1,0(PSP) \
+THEN
+\ XOR TOS,S \ S contains sign of result
+\ CMP #0,TOS \ n2 > -1 ?
+\ S< IF
+\ XOR #-1,TOS \ n2 --> u2
+\ ADD #1,TOS \
+\ THEN
+\ PUSHM #2,IP \ UMSTAR use S,T,W,X,Y, we save IP,S
+PUSHM #6,IP \ UMSTAR use S,T,W,X,Y, we save IP,S,T,W,X,Y
+LO2HI \ -- ud1 u2
+UM*
+HI2LO
+\ POPM #2,IP \ pop S,IP
+POPM #6,IP \ pop Y,X,W,T,S,IP
+CMP #0,S \ sign of result > -1 ?
+S< IF
+ XOR #-1,0(PSP) \ ud --> d
+ XOR #-1,TOS
+ ADD #1,0(PSP)
+ ADDC #0,TOS
+THEN
+\ MOV @IP+,PC
+\ ENDCODE
+\ -----------------------------------------------
+MOV TOS,X \ hi result --> X
+ADD #2,PSP
+MOV @PSP+,TOS \ restore data stack
+MOV @RSP+,PC \ RET
+ENDASM
+
+
+
+[ELSE] ; hardware multiplier
+
+[UNDEFINED] F#S [IF]
+\ F#S Qlo Qhi u -- Qhi 0 convert fractionnal part of Q15.16 fixed point number
+\ with u digits
+CODE F#S
+ MOV 2(PSP),X \ -- Qlo Qhi u X = Qlo
+ MOV @PSP,2(PSP) \ -- Qhi Qhi u
+ MOV X,0(PSP) \ -- Qhi Qlo u
+ MOV TOS,T \ T = len
+ MOV #0,S \ S = count
+BEGIN MOV @PSP,&MPY \ Load 1st operand
+ MOV &BASEADR,&OP2 \ Load 2nd operand
+ MOV &RES0,0(PSP) \ -- Qhi RESlo x low result on stack
+ MOV &RES1,TOS \ -- Qhi RESlo REShi high result in TOS
+ CMP #10,TOS \ digit to char
+ U>= IF ADD #7,TOS
+ THEN ADD #$30,TOS
+ MOV.B TOS,HOLDS_ORG(S) \ -- Qhi RESlo char char to string
+ ADD #1,S \ count+1
+ CMP T,S \ count=len ?
+0= UNTIL MOV T,TOS \ -- len RESlo len
+ MOV #0,0(PSP) \ -- Qhi 0 len
+ MOV #HOLDS_ORG,X \ -- Qhi 0 len X=HOLDS_ORG
+ GOTO BW3 \ 35~ JMP HOLDS+2
ENDCODE
[THEN]
+ASM XSCALE \ X = X*Cordic_Gain
+MOV X,&MPY \ 3 Load 1st operand
+MOV T_SCALE(W),&OP2 \ 3 CORDIC Gain * 65536
+MOV &RES1,X \ 3 hi result = hypothenuse
+MOV @RSP+,PC \ RET
+ENDASM
+
+[THEN] ; endcase of hardware multiplier
+
+
+[UNDEFINED] F. [IF]
CODE F. \ display a Q15.16 number with 4/5/16 digits after comma
MOV TOS,S \ S = sign
MOV #4,T \ T = 4 preset 4 digits for base 16 and by default
TYPE $20 EMIT \ --
;
-[THEN] \ end of [UNDEFINED] {FIXPOINT}
-
-\ CORDIC USES
-\ OPERATION | MODE | INITIALIZE x y z | DIRECTION | RESULT | post operation
-\ --------------|-----------|-----------------------|---------------|-------------------|
-\ sine, cosine | Rotation | x=1, y=0, z=angle | Reduce z to 0 | cos=x*Gi,sin=y*Gi | mutiply by 1/Gi
-\ --------------|-----------|-----------------------|---------------|-------------------|
-\ Polar to Rect | Rotation | x=magnit, y=0, Z=angle| Reduce z to 0 | X=x*Gi, Y=y*Gi | mutiply by 1/Gi
-\ --------------|-----------|-----------------------|---------------|-------------------|
-\ Rotation | Rotation | x=X, y=Y, z=angle | Reduce z to 0 | X'=x*Gi,Y'=y*Gi | <=== not implemented
-\ --------------|-----------|-----------------------|---------------|-------------------|
-\ Rect to Polar | Vector | x=X, y=Y, z=0 | Reduce y to 0 | hyp=x*Gi, angle=z | mutiply hyp by 1/Gi
-\ --------------|-----------|-----------------------|---------------|-------------------|
-\ Gi = CORDIC gain for i iterations; Gi < 1
-\
-
-CREATE T_ARCTAN \ ArcTan table
-11520 , \ 256 * 45
-6801 , \ 256 * 26.565
-3593 , \ 256 * 14.036
-1824 , \ 256 * 7.125
-916 , \ 256 * 3.576
-458 , \ 256 * 1.790
-229 , \ 256 * 0.895
-115 , \ 256 * 0.448
-57 , \ 256 * 0.224
-29 , \ 256 * 0.112
-14 , \ 256 * 0.056
-7 , \ 256 * 0.028
-4 , \ 256 * 0.014
-2 , \ 256 * 0.007
-1 , \ 256 * 0.003
-
-CREATE T_SCALE \ 1/Gi table
-46340 , \ = 65536 * cos(45)
-41448 , \ = 65536 * cos(45) * cos(26.565)
-40211 , \ = 65536 * cos(45) * cos(26.565) * cos(14.036)
-39900 , \ = 65536 * cos(45) * cos(26.565) * cos(14.036) * ...
-39822 ,
-39803 ,
-39798 ,
-39797 ,
-39797 ,
-39797 ,
-39797 ,
-39797 ,
-39797 ,
-39797 ,
-39797 ,
-
+[THEN]
CODE POL2REC \ u f -- X Y
\ input ; u = module {1000...16384}, f = angle (15Q16 number) in degrees {1,0...89,0}
0= UNTIL
THEN \ search "Extended control-flow patterns" in https://forth-standard.org/standard/rationale
\ multiply cos by factor scale
-MOV X,&MPY \ 3 Load 1st operand
-MOV T_SCALE(W),&OP2 \ 3 Load 2nd operand
-MOV &RES1,0(PSP) \ 3 hi result = cos
+CALL #XSCALE
+MOV X,0(PSP) \ 3 hi result = cos
\ multiply sin by factor scale
-MOV Y,&MPY \ 3 Load 1st operand
-MOV T_SCALE(W),&OP2 \ 3 Load 2nd operand
-MOV &RES1,TOS \ 3 hi result = sin
+MOV Y,X \ 3
+CALL #XSCALE
+MOV X,TOS \ 3 hi result = sin
\ ==================
\ endof CORDIC engine \ X = cos, Y = sin
\ ==================
0= UNTIL \ |
THEN \ <---------------------+
\ multiply x by CORDIC gain
-MOV X,&MPY \ 3 Load 1st operand
-MOV T_SCALE(W),&OP2 \ 3 CORDIC Gain * 65536
-MOV &RES1,X \ 3 hi result = hypothenuse
+CALL #XSCALE \ 3 hi result = hypothenuse
\ ==================
\ endof CORDIC engine \ X = hypothenuse, TOS = 256*angle
\ ==================
MOV @IP+,PC
ENDCODE \
-RST_HERE
+PWR_HERE
-[THEN]
+[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]
[UNDEFINED] ROT [IF] \
\ https://forth-standard.org/standard/core/ROT
ENDCODE
[THEN]
+[UNDEFINED] DO [IF] \ define DO LOOP +LOOP
+\ 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
+
+\ https://forth-standard.org/standard/core/LOOP
+\ LOOP DOadr -- L-- an an-1 .. a1 0
+CODE LOOP \ immediate
+ MOV #XLOOP,X
+BW1 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
+ MOV @PSP+,TOS
+ MOV @IP+,PC
+ENDCODE IMMEDIATE
+
+\ 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]
+
: 1000CORDIC
500 0 DO
POL2REC REC2POL \ 2 CORDIC op. * 500 loops = 1000 CORDIC
10000 7,125 1000CORDIC ROT . F.
10000 1,0 1000CORDIC ROT . F.
-
+PWR_STATE \ remove tests
OSDN Git Service
