Scr#1
\ Floating Point FABS,FNEGATE
\ Assembler is required
VARIABLE IPSAVE

MACRO .POP B POP H POP ENDM
MACRO .PSH H PUSH B PUSH ENDM
MACRO .POP2 EXX B POP EXX
 D POP .POP ENDM

MACRO .NEG C A LD 80 XOR# A C LD
 ENDM
MACRO .ABS C A LD 7F AND# A C LD
 ENDM
MACRO .0= C A LD 7F AND# B OR L
 OR H OR ENDM

CODE FABS B POP .ABS B PUSH
 JPIX ;C
CODE FNEGATE B POP .NEG B PUSH
 JPIX ;C
CODE F0= .POP .0= H CLR Z IF
H DEC THEN H PUSH JPIX ;C
CODE F0< .POP .0= NZ IF C A LD
80 AND# THEN H CLR NZ IF H DEC
THEN H PUSH JPIX ;C

MACRO I! IPSAVE D STP ENDM
MACRO I@ IPSAVE D LDP ENDM
MACRO .0=2 EXX 7F A LD# C AND
B OR EXX E OR D OR ENDM
-->


Scr#2
\ FLOATING POINT LABELS & MACROS


LABEL RNORM CS IF C RR H RR L RR
 B INR Z IF -1 H LDP# L B LD L C
 LD ELSE CS IF L INR Z IF H INR
 Z IF C INR THEN THEN THEN THEN
 THEN RET ;C
LABEL USE0 H CLR L C LD L B LD
 RET ;C
LABEL LNORM BEGIN C A LD 80 AND#
 Z WHILE H ADDP C RL B DER B INR
 USE0 JPZ B DER REPEAT RET ;C
LABEL ALLIGN
     BEGIN EXX C SRL EXX D RR
E RR A DER Z UNTIL CS IF E INR Z
 IF D INR Z IF EXX C INR EXX THE
N THEN THEN      RET ;C

LABEL .F< B A LD EXX B SUB EXX
 Z IF C A LD EXX C SUB EXX Z IF
 H A LD D SUB Z IF L A LD E SUB
 THEN THEN THEN RET ;C
LABEL EXG B PUSH EXX D POP B PUS
H D B MOV EXX B POP EXDE RET ;C

LABEL SIGNS@ C A LD 80 AND#
 EXX A H LD C A LD 80 AND#
 A L LD C A LD 80 OR# A C LD
 EXX C A LD 80 OR# A C LD EXX
 L A LD H XOR EXX RET ;C  -->


Scr#3
\ FLOATING POINT F+,F-,F<,F=
LABEL .ADD B A LD EXX B SUB EXX
  CS IF EXG CALL NEG THEN
EXAF  .0=2 NZ IF EXAF
  ALLIGN z NOT CALLC D ADDP C A
LD  EXX C ADC EXX A C LD RNORM
CALL THEN EXX 7F A LD# H OR EXX
C AND  A C LD RET ;C
LABEL .SUB .F< CALL CS IF
 EXG CALL EXX        L H LD  EXX
       THEN B A LD EXX B SUB EXX
      EXAF .0=2 NZ IF EXAF
      ALLIGN z NOT CALLC D SUBP
C A LD EXX C SBC EXX A C LD LNOR
M CALL THEN EXX 7F A LD# H OR EX
X C AND A C LD RET ;C

CODE F+ I! .POP2 SIGNS@ CALL Z
IF .ADD CALL ELSE .SUB CALL THEN
 .PSH I@ JPIX ;C
CODE F- I! .POP2 EXX C A LD 80 X
OR# A C LD EXX SIGNS@ CALL Z IF
 .ADD CALL ELSE .SUB CALL THEN
 .PSH I@ JPIX ;C
CODE F< I! .POP2 SIGNS@ CALL
 EXX H A LD L SUB EXX  .F< z
 CALLC 0 A LD# 0 SBC# A H LD
 A L LD H PUSH I@ JPIX ;C
: F= 2OVER 2OVER D- OR 0= IF
2DROP 2DROP -1 ELSE F0= >R F0=
R> AND THEN ; -->


Scr#4
\ FLOATING POINT F>,F2*,F2/,F->D
: F> 2SWAP F< ;

CODE F2* .POP B INR Z IF -1 H
 LDP# H B MOV THEN .PSH JPIX ;C
CODE F2/ .POP B DER B INR Z IF
 H CLR 100 B LDP# THEN B DER
 .PSH JPIX ;C
CODE X@ H POP  H PUSH    H L LD
 0 H LD# H PUSH JPIX ;C
CODE X! H POP B POP L B LD
 B PUSH JPIX ;C

CODE F->D .POP B A LD 80 SUB#
 CS IF H CLR H PUSH H PUSH JPIX
 THEN EXAF C A LD 80 AND# EXAF
 C A LD 80 OR# A C LD B A LD
 0 B LD# 97 CP# NZ IF CS IF
 BEGIN B SRL C RR H RR L RR
 A INR 97 CP# Z UNTIL ELSE
 BEGIN H ADDP C RL B RL A DER
 97 CP# Z UNTIL THEN THEN
 EXAF NZ IF A XOR L SUB A L LD
 0 A LD# H SBC A H LD 0 A LD
 C SBC A C LD 0 A LD# B SBC A B
LD THEN .PSH JPIX ;C
-->






Scr#5
\ FLOATING POINT D->F,F*
CODE D->F .POP B A LD C OR
 L OR H OR NZ IF B A LD 80 AND#
 NZ IF EXAF A XOR L SUB A L LD 0
 A LD# H SBC A H LD 0 A LD# C SB
C A C LD 0 A LD# B SBC A B LD
EXAF THEN EXAF B A LD A AND Z IF
 97 B LD# BEGIN C A LD 80 AND#
 Z WHILE H ADDP C RL B DER
 REPEAT ELSE I! 97 E LD# BEGIN
B SRL C RR H RR L RR B A LD E
INR A AND Z UNTIL E B LD I@ THEN
 EXAF Z IF C A LD 7F AND# A C LD
 THEN THEN .PSH JPIX ;C
CODE F* I! .POP2 SIGNS@ CALL
 .0= NZ IF .0=2 NZ IF
B A LD 80 SUB# A B LD EXX B A LD
 80 SUB# EXX B ADD  v if 7F XOR#
 A H LD A L LD H PUSH H PUSH I@
 JPIX then 80 SUB# A B LD EXX H
PUSH D CLR 18 B LD# EXX H PUSH H
 CLR EXX H POP EXX BEGIN EXX
 H ADDP EXX C RL   CS IF D ADDP
 EXX C A LD E ADC A E LD CS IF D
 INR THEN EXX THEN EXX C SRL EXX
 D RR E RR EXX B DER EXX Z UNTIL
 EXX       E A LD D RR EXX A C
 LD RNORM CALL C A LD D POP D
 XOR E XOR 80 XOR# A C LD
 .PSH I@ JPIX THEN THEN B CLR H
 CLR .PSH I@ JPIX ;C -->


Scr#6
\ FLOATING POINT F/,FI**
CODE F/ I! .POP2 SIGNS@ CALL .0=
2 Z IF D DEC D PUSH D PUSH I@
 JPIX THEN EXX B A LD 7F SUB# A
 B LD EXX B A LD 80 SUB# EXX B
 SUB EXX v if 7F XOR# A L LD
 A H LD H PUSH H PUSH I@ JPIX
 then 80 SUB# A B LD EXX H PUSH
 18 B LD# BEGIN EXX D SUBP C A L
D EXX C SBC EXX A C LD CCF NC IF
 D ADDP C A LD EXX C ADC EXX A C
 LD A AND THEN EXX H ADCP E RL C
 SRL EXX D RR E RR EXX B DER Z U
NTIL  H ADDP E RL E A LD H PUSH
EXX A C LD H POP RNORM CALL D PO
P C A LD D XOR E XOR 80 XOR# A C
 LD      .PSH I@ JPIX ;C




: 2CONSTANT CREATE , , DOES> 2@
;  1. D->F 2CONSTANT 1&
10. D->F 2CONSTANT 10&
HEX FF.7FFFFF 2CONSTANT NAN
DECIMAL
: FI** DUP 0< >R ABS 1&
  ROT BEGIN DUP WHILE DUP 1 AND
  IF 1- >R 2OVER F* R> ELSE 2/
  >R 2SWAP 2DUP F* 2SWAP R> THEN
  REPEAT DROP 2SWAP 2DROP
  R> IF 1& 2SWAP F/ THEN ; -->

Scr#7
\ FLOATING POINT FERRNUM,F.
: FERRNUM IF DUP C@ && = IF
  DPL @ 0 MAX DPL ! 1+
  >R D->F BASE @ 0 D->F DPL @
  NEGATE FI**  F* 0.0 R@ DUP C@
  BL - IF CONVERT THEN DROP R>
  C@ &- = IF DNEGATE THEN DROP
  BASE @ 0 D->F ROT FI** F*
  R> DROP R> IF FNEGATE THEN
  ELSE 1 ABORT" Can't find"
  THEN THEN ;
: FLOAT ['] FERRNUM 'ERRNUM ! ;
FLOAT

: F. BASE @ >R 10 BASE ! 2DUP
  F0< -ROT FABS 2DUP NAN D- OR
  IF X@ 128 - 4 / DUP >R NEGATE
  10& ROT FI** F* 2DUP
  999.999.95& F< IF  2DUP F0= IF
  R> DROP -6 >R ELSE  BEGIN 10&
  F* R> 1- >R 2DUP 999.999.95&
  F< 0= UNTIL  THEN
  ELSE BEGIN 2DUP 9999.999.5& F<
  0= WHILE 10& F/ R> 1+ >R
  REPEAT THEN R> 6 + DUP ABS 0
  <# # # 2DROP 0< IF &- ELSE &+
  THEN HOLD && HOLD  .5& F+ F->D
  # # # # # # &. HOLD # ROT 0<
  IF &-  ELSE BL THEN HOLD #>
  TYPE ELSE 2DROP IF &- ELSE BL
  THEN EMIT ." *.******&+**"
  THEN SPACE R> BASE ! ; -->

Scr#8
\ FLOATING POINT FSQRT,F.R

: FSQRT 2DUP F0< IF 2DROP NAN
  ELSE 2DUP F0= IF 2DROP 0.
  ELSE 2DUP X@ 128 - 2/ 128 + X!
  4 0 DO
  2OVER 2OVER F/ F+ F2/
  LOOP 2SWAP 2DROP THEN THEN ;

: F.R SWAP >R BASE @ 0 D->F
  ROT DUP >R FI** F* 2DUP F0<
  -ROT FABS 0.5& F+ F->D <# R> 0
  ?DO  # LOOP &. HOLD #S ROT
  SIGN #> R> OVER - 0 MAX SPACES
  TYPE ;

