\ sfdf 05.2.27 NAB
\ original 01.4.4 JCF
\ Included by NewFloatMgr.

needs core-ext

: (2swap) ( d1 d2 x -- d2 d1 x )
[
4 (hex) 202C cs, cs, \ move.l 4(sp),d0
4 (hex) 2954 cs, cs, \ " (sp),4(sp)
(hex) 2880 cs, \ move.l d0,(sp)
] ;

: SFLOAT+ ( sf-addr1 -- sf-addr2 )
  4 + ;
: DFLOAT+ ( df-addr1 -- df-addr2 )
  8 + ;

: SFLOATS ( n1 -- n2 ) 4 * ;
: DFLOATS ( n1 -- n2 ) 8 * ;

: SFALIGNED ( addr -- sf-addr )
  ALIGNED ;
: DFALIGNED ( addr -- df-addr )
  ALIGNED ;

: SFALIGN ( -- ) ALIGN ;
: DFALIGN ( -- ) ALIGN ;

: SF@SF ( sf-addr -- sf ) 2@ ;
: DF@DF ( df-addr -- df )
  DUP >R CELL+ CELL+ 2@
  R> 2@ ;

: SF!SF ( sf sf-addr -- ) 2! ;
: DF!DF ( df df-addr -- )
  DUP >R 2! R> CELL+ CELL+ 2! ;

: SF, ( sf -- )
  HERE 1 SFLOATS ALLOT SF!SF ;
: DF, ( df -- )
  HERE 1 DFLOATS ALLOT DF!DF ;

: SFDROP ( sf -- ) 2DROP ;
: DFDROP ( df -- ) 2DROP 2DROP ;

: SFDUP ( sf -- sf sf ) 2DUP ;
: DFDUP ( df -- df df )
  2DUP 2>R 2OVER 2R> ;

: SFLITERAL ( sf -- ) 
  POSTPONE 2LITERAL ; immediate
: DFLITERAL ( df -- ) 2SWAP
  POSTPONE 2LITERAL
  POSTPONE 2LITERAL ; immediate

: SFCONSTANT
( sf "<spaces>name" -- )
  2CONSTANT ;
: DFCONSTANT
( df "<spaces>name" -- )
  :  dup
  2rot  postpone 2literal
  2swap  postpone 2literal
  drop
  postpone ;
;

: SFOVER ( s1 s2 -- s1 s2 s1 )  2OVER ;
: DFOVER ( d1 d2 -- d1 d2 d1 )
  7 PICK 7 PICK 7 PICK 7 PICK ;

: SFSWAP ( s1 s2 -- s2 s1 ) 2SWAP ;
: DFSWAP ( d1 d2 -- d2 d1 )
  7 ROLL 7 ROLL 7 ROLL 7 ROLL ;

: SFROT ( s1 s2 s3 -- s2 s3 s1 )  2ROT ;
: DFROT ( d1 d2 d3 -- d2 d3 d1 )
  DUP (2>r) (2>r) DROP
  DFSWAP
  DUP (2r>) (2r>) DROP
  DFSWAP ;

: SFVARIABLE ( "<spaces>name" -- )
  SFALIGN CREATE 1 SFLOATS ALLOT ;
: DFVARIABLE ( "<spaces>name" -- )
  DFALIGN CREATE 1 DFLOATS ALLOT ;

: (4>r)  (2swap) (2>r) (2>r) ; inline
: (4r>)  (2r>) (2r>) (2swap) ; inline
: 4>R  DUP (4>r) DROP ; inline
: 4R>  DUP (4r>) DROP ; inline
