Atari Math Routines: file extension and file access changes

This commit is contained in:
Carsten Strotmann 2020-07-15 08:29:26 +02:00
parent dff8893c75
commit c5cda9f484
9 changed files with 11 additions and 133 deletions

View File

@ -1,118 +0,0 @@
\ Floating Point Extension
\ using Atari 8bit ROM FP Routines
\ based on FIG Forth APX20029
\needs CALL INCLUDE" D:CALL.FS"
CR .( loading Floating Point ext. )
VOCABULARY FMATH
FMATH ALSO DEFINITIONS
$D4 CONSTANT FR0
$E0 CONSTANT FR1
$FC CONSTANT FLPTR
$F3 CONSTANT INBUF
$F2 CONSTANT CIX
| : XCALL CALL DROP ;
| : AFP $D800 XCALL ;
| : FASC $D8E6 XCALL ;
| : IFP $D9AA XCALL ;
| : FPI $D9D2 XCALL ;
| : FADD $DA66 XCALL ;
| : FSUB $DA60 XCALL ;
| : FMUL $DADB XCALL ;
| : FDIV $DB28 XCALL ;
| : FLG $DECD XCALL ;
| : FLG10 $DED1 XCALL ;
| : FEX $DDC0 XCALL ;
| : FEX10 $DDCC XCALL ;
| : FPOLY $DD40 XCALL ;
: F@ ( -- fp )
>R R@ @ R@ 2+ @ R> 4 + @ ;
: F! ( fp addr -- )
>R R@ 4 + ! R@ 2+ ! R> ! ;
: F.TY ( -- )
BEGIN
INBUF @ C@ DUP $7F AND EMIT
1 INBUF +!
$80 > UNTIL ;
: FSWAP ( fp1 fp2 -- fp2 fp1 )
5 ROLL 5 ROLL 5 ROLL ;
: FDROP ( fp -- )
2DROP DROP ;
: FDUP ( fp -- fp fp )
2 PICK 2 PICK 2 PICK ;
: FOVER ( fp1 fp2 -- fp1 fp2 fp1 )
5 PICK 5 PICK 5 PICK ;
: F. ( fp -- )
FR0 F@ FSWAP FR0 F!
FASC F.TY SPACE
FR0 F! ;
: F? ( fp -- )
F@ F. ;
: <F ( fp1 fp2 -- )
FR1 F! FR0 F! ;
: F> ( -- fp1 )
FR0 F@ ;
: FS ( fp -- )
FR0 F! ;
: F+ <F FADD F> ;
: F- <F FSUB F> ;
: F* <F FMUL F> ;
: F/ <F FDIV F> ;
: FLOAT ( n -- fp )
FR0 ! IFP F> ;
: FIX ( fp -- n )
FS FPI FR0 @ ;
: FLOG FS FLG F> ;
: FLOG10 FS FLG10 F> ;
: FEXP FS FEX F> ;
: FEXP10 FS FEX10 F> ;
: ASCF ( addr -- fp )
INBUF ! 0 CIX C! AFP F> ;
: F0= OR OR 0= ;
: F= F- F0= ;
: F< F- 2DROP $80 AND 0 > ;
: F, ( fp -- )
ROT , SWAP , , ;
: FCONSTANT
CREATE F, DOES> F@ ;
: FVARIABLE
CREATE 6 ALLOT DOES> ;
| : FLIT
R> DUP 6 + >R F@ ;
: FLITERAL
COMPILE FLIT F, ;
: FLOATING
BL WORD 1+
ASCF FLITERAL ; IMMEDIATE
: [FLOATING] [COMPILE] FLOATING ; IMMEDIATE
CR .( Floating Point ext. loaded. ) CR
ONLYFORTH

View File

@ -2,7 +2,7 @@
\ using Atari 8bit ROM FP Routines
\ based on FIG Forth APX20029
\needs CALL INCLUDE" D:CALL.FS"
\needs CALL INCLUDE" D:CALL.FTH"
CR .( loading Floating Point ext. )
@ -63,7 +63,7 @@ $F2 CONSTANT CIX
: F? ( addr -- )
F@ F. ;
: <F ( fp1 fp2 -- )
: <F ( fp1 fp2 -- )
FR1 F! FR0 F! ;
: F> ( -- fp1 )
@ -77,7 +77,7 @@ $F2 CONSTANT CIX
: F* <F FMUL F> ;
: F/ <F FDIV F> ;
: FLOAT ( n -- fp )
: FLOAT ( n -- fp )
FR0 ! IFP F> ;
: FIX ( fp -- n )
@ -100,19 +100,18 @@ $F2 CONSTANT CIX
: FCONSTANT
CREATE F, DOES> F@ ;
: FVARIABLE
: FVARIABLE
CREATE 6 ALLOT DOES> ;
| : FLIT
R> DUP 6 + >R F@ ;
: FLITERAL
COMPILE FLIT F, ;
: FLOATING
BL WORD 1+
: FLOATING
BL WORD 1+
ASCF FLITERAL ; IMMEDIATE
: [FLOATING] [COMPILE] FLOATING ; IMMEDIATE
CR .( Floating Point ext. loaded. ) CR
ONLYFORTH
ONLYFORTH

View File

@ -1,6 +1,6 @@
\ 100* 100U/
\needs code INCLUDE" D:TAS65.FS
\needs code INCLUDE" D:TAS65.FTH"
CODE 100* ( N1 - N2)
SP X) LDA
@ -86,4 +86,3 @@ CODE 100U/ ( U - N)
N 4 + ROR
4/+ JSR
NEXT JMP END-CODE

View File

@ -1 +0,0 @@
\ SQRT  \needs code INCLUDE" D:TAS65.FS"  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 ; 

View File

@ -1,6 +1,6 @@
\ SQRT
\needs code INCLUDE" D:TAS65.FS"
\needs code INCLUDE" D:TAS65.FTH"
CODE D2* ( D1 - D2)
2 # LDA SETUP JSR
@ -42,7 +42,7 @@ NEXT JMP END-CODE
\ Test
\
\ : XX
\ : XX
\ &16 * &62500 UM*
\ SQRT 0 <# # # # ASCII . HOLD #S #>
\ TYPE SPACE ;

View File

@ -1,7 +1,7 @@
\ A SINUS-TABLE 20OCT87RE
\ SINUS-TABLE FROM FD Vol IV/1
\needs code INCLUDE" D:TAS65.FS"
\needs code INCLUDE" D:TAS65.FTH"
| : TABLE ( VALUES N -)
CREATE 0 DO , LOOP
@ -47,4 +47,3 @@ BASE !
: TAN ( DEG -- TAN*10000)
DUP SIN SWAP COS ?DUP
IF &100 SWAP */ ELSE 3 * THEN ;

0
6502/Atari8bit/math/fmath.atr Executable file → Normal file
View File

0
6502/Atari8bit/math/fmath.zip Executable file → Normal file
View File