mirror of
https://github.com/forth-ev/VolksForth.git
synced 2024-06-01 06:41:37 +00:00
123 lines
2.6 KiB
Forth
123 lines
2.6 KiB
Forth
\ A SINUS-TABLE 20OCT87RE
|
|
\ SINUS-TABLE FROM FD Vol IV/1
|
|
|
|
\needs code INCLUDE" D:TAS65.FS"
|
|
|
|
| : TABLE ( VALUES N -)
|
|
CREATE 0 DO , LOOP
|
|
;CODE ( N - VALUE)
|
|
SP X) LDA CLC 1 # ADC .A ASL TAY
|
|
W )Y LDA SP X) STA
|
|
INY W )Y LDA 1 # LDY SP )Y STA
|
|
NEXT JMP END-CODE
|
|
|
|
10000 9998 9994 9986 9976 9962 9945 9925
|
|
9903 9877 9848 9816 9781 9744 9703 9659
|
|
9613 9563 9511 9455 9397 9336 9272 9205
|
|
9135 9063 8988 8910 8829 8746 8660 8572
|
|
8480 8387 8290 8192 8090 7986 7880 7771
|
|
7660 7547 7431 7314 7193 7071 6947 6820
|
|
6691 6561 6428 6293 6157 6018 5878 5736
|
|
5592 5446 5299 5150 5000 4848 4695 4540
|
|
4384 4226 4067 3907 3746 3584 3420 3256
|
|
3090 2924 2756 2588 2419 2250 2079 1908
|
|
1736 1564 1392 1219 1045 0872 0698 0523
|
|
0349 0175 0000
|
|
|
|
&91 | TABLE SINTABLE
|
|
|
|
| : S180 ( DEG -- SIN*10000:SIN 0-180)
|
|
DUP &90 >
|
|
IF &180 SWAP - THEN
|
|
SINTABLE ;
|
|
|
|
: SIN ( DEG -- SIN*10000)
|
|
&360 MOD DUP 0< IF &360 + THEN
|
|
DUP &180 >
|
|
IF &180 - S180 NEGATE
|
|
ELSE S180 THEN ;
|
|
|
|
: COS ( DEG -- COS*10000)
|
|
&360 MOD &90 + SIN ;
|
|
|
|
: TAN ( DEG -- TAN*10000)
|
|
DUP SIN SWAP COS ?DUP
|
|
IF &100 SWAP */ ELSE 3 * THEN ;
|
|
|
|
CODE D2* ( D1 - D2)
|
|
2 # LDA SETUP JSR
|
|
N 2+ ASL N 3 + ROL N ROL N 1+ ROL
|
|
SP 2DEC N 3 + LDA SP )Y STA
|
|
N 2+ LDA SP X) STA
|
|
SP 2DEC N 1+ LDA SP )Y STA
|
|
N LDA SP X) STA
|
|
NEXT JMP END-CODE
|
|
|
|
: DU< &32768 + ROT &32768 + ROT ROT D< ;
|
|
|
|
| : EASY-BITS ( N1 -- N2)
|
|
0 DO
|
|
>R D2* D2* R@ - DUP 0<
|
|
IF R@ + R> 2* 1-
|
|
ELSE R> 2* 3 +
|
|
THEN
|
|
LOOP ;
|
|
|
|
| : 2'S-BIT
|
|
>R D2* DUP 0<
|
|
IF D2* R@ - R> 1+
|
|
ELSE D2* R@ 2DUP U<
|
|
IF DROP R> 1- ELSE - R> 1+ THEN
|
|
THEN ;
|
|
|
|
| : 1'S-BIT
|
|
>R DUP 0<
|
|
IF 2DROP R> 1+
|
|
ELSE D2* &32768 R@ DU< 0=
|
|
NEGATE R> +
|
|
THEN ;
|
|
|
|
: SQRT ( UD1 - U2)
|
|
0 1 8 EASY-BITS
|
|
ROT DROP 6 EASY-BITS
|
|
2'S-BIT 1'S-BIT ;
|
|
|
|
\ Test
|
|
\
|
|
\ : XX
|
|
\ &16 * &62500 UM*
|
|
\ SQRT 0 <# # # # ASCII . HOLD #S #>
|
|
\ TYPE SPACE ;
|
|
|
|
CODE 100* ( N1 - N2)
|
|
SP X) LDA N STA SP )Y LDA N 1+ STA
|
|
N ASL N 1+ ROL N ASL N 1+ ROL
|
|
N LDA N 2+ STA N 1+ LDA N 3 + STA
|
|
N 2+ ASL N 3 + ROL N 2+ ASL N 3 + ROL
|
|
N 2+ ASL N 3 + ROL
|
|
CLC N LDA N 2+ ADC N STA
|
|
N 1+ LDA N 3 + ADC N 1+ STA
|
|
N 2+ ASL N 3 + ROL
|
|
CLC N LDA N 2+ ADC SP X) STA
|
|
N 1+ LDA N 3 + ADC SP )Y STA
|
|
NEXT JMP END-CODE
|
|
|
|
LABEL 4/+
|
|
N 7 + LSR N 6 + ROR N 5 + ROR N 4 + ROR
|
|
N 7 + LSR N 6 + ROR N 5 + ROR N 4 + ROR
|
|
CLC N LDA N 4 + ADC N STA
|
|
N 1+ LDA N 5 + ADC N 1+ STA
|
|
SP X) LDA N 6 + ADC SP X) STA
|
|
SP )Y LDA N 7 + ADC SP )Y STA RTS
|
|
|
|
CODE 100U/ ( U - N)
|
|
N STX N 4 + STX
|
|
SP X) LDA .A ASL N 1+ STA N 5 + STA
|
|
SP )Y LDA .A ROL SP X) STA N 6 + STA
|
|
TXA .A ROL SP )Y STA N 7 + STA
|
|
4/+ JSR
|
|
N 7 + LSR N 6 + ROR N 5 + ROR N 4 + ROR
|
|
4/+ JSR
|
|
NEXT JMP END-CODE
|
|
|