home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 420.lha / kFloat_v1.0 / kFloat < prev    next >
Encoding:
Text File  |  1990-09-30  |  9.0 KB  |  310 lines
  1. \ kFloat v1.0 -    Redefines some words of ju:float.ffp to improve
  2. \                  execution time.
  3. \ Jerry Kallaus  05/08/89
  4. \
  5. \ Please limit distribution of this code; consider it preliminary
  6. \ experimental code.  A new version will be released after more
  7. \ exhaustive testing has occurred.
  8. \
  9. \ The following words are redefined.
  10. \ F+  F-  F*  F/  Float  Int  Fix  F2*  F2/
  11. \
  12. \ The following floating pointing condition checking words
  13. \ are also redefined.
  14. \ FEQ FNE FLT FLE FGE FGT FVC FVS
  15. \
  16. \ When the variable FP-STATUS? is TRUE, the floating point condition
  17. \ checking words may be used; when FP-STATUS? is FALSE these words
  18. \ may NOT be used, and the arithmetic operators listed above will
  19. \ not generate code to save condition codes.
  20. \ FP-STATUS? may be turned on and off as desired during compilation
  21. \ and is TRUE by default.
  22. \ The angle unit conversion words are also redefined.
  23. \ See the ReadMe file for more information.
  24.  
  25.  
  26. Include?  f+  ju:float.ffp
  27.  
  28. Anew task-kFloat
  29.  
  30. Variable FP-Status?   FP-Status? ON
  31.  
  32.  
  33. \  Prelude code for 2 operand float ops
  34.  
  35. Asm F.Pre2
  36.     move.l  tos,d1                 right operand
  37.     move.l  (dsp)+,d0              left operand
  38.     move.l  a6,d3                  save dsp
  39.     forth{  mathffp_lib  ] aliteral [  }
  40.     move.l  $0(org,tos.l),a6
  41.     Forth{ inline }
  42. End-Code
  43.  
  44.  
  45. \ Postlude code for floating ops with no GetCC
  46.  
  47. Asm F.Post
  48.     move.l  d0,tos
  49.     move.l  d3,a6                  restore dsp
  50.     Forth{  inline }
  51. End-Code
  52.  
  53.  
  54. \ Postlude code for floating ops with GetCC
  55.  
  56. Asm F.PostCC
  57.     exg     d0,tos                 preserve condition codes
  58.     move.l  $4,a6                  _ExecBase
  59.     jsr.l   $-210(a6)              GetCC
  60.     move.l  d3,a6                  restore dsp
  61.     forth{  fpstat ] aliteral [ }
  62.     move.w  d0,$0(org,tos.l)
  63.     move.l  (dsp)+,tos
  64.     Forth{  inline }
  65. End-Code
  66.  
  67.  
  68. \ Move condition code to variable FPStat
  69.  
  70. Asm CC.To.FPStat
  71.     exg     d3,a6                  preserve condition codes
  72.     move.l  $4,a6                  _ExecBase
  73.     jsr.l   $-210(a6)              GetCC
  74.     move.l  d3,a6                  restore dsp
  75.     forth{  fpstat ] aliteral [ }
  76.     move.w  d0,$0(org,tos.l)
  77.     move.l  (dsp)+,tos
  78.     Forth{  inline }
  79. End-Code
  80.  
  81. \ Jump subroutine instructions for floating +,-,*,/
  82.  
  83. Asm FJ.+
  84.     jsr     $-42(a6)
  85.     Forth{  inline }
  86. End-Code
  87.  
  88. Asm FJ.-
  89.     jsr     $-48(a6)
  90.     Forth{  inline }
  91. End-Code
  92.  
  93. Asm FJ.*
  94.     jsr     $-4E(a6)
  95.     Forth{  inline }
  96. End-Code
  97.  
  98. Asm FJ./
  99.     jsr     $-54(a6)
  100.     Forth{  Inline }
  101. End-Code
  102.  
  103. : F/0Msg fpwarn @ IF cr ." Floating Point Divide by Zero !!!!" THEN inline ;
  104.  
  105. Asm F/0Err
  106.     CallCFA F/0Msg
  107.     addq.l  #4,dsp
  108.     moveq.l #0,tos
  109.     ori-ccr #2
  110.     Forth{  inline }
  111. End-Code
  112.  
  113.  
  114. \ Subroutines for floating point arithmetic operators with no GetCC
  115.  
  116. : F.+    f.pre2  fj.+  f.post    Both ;
  117. : F.-    f.pre2  fj.-  f.post    Both ;
  118. : F.*    f.pre2  fj.*  f.post    Both ;
  119.  
  120. Asm F./
  121.     tst.l   tos              Test for zero divisor
  122.     bne.s   1$               Branch on not zero
  123.     CallCFA f/0err           Give error message
  124.     bra.s   2$
  125. 1$: CallCFA f.pre2
  126.     CallCFA fj./
  127.     CallCFA f.post
  128. 2$: Forth{ both }
  129. End-Code
  130.  
  131.  
  132. \ Subroutines for floating point arithmetic operators with GetCC
  133.  
  134. : FCC.+  f.pre2  fj.+  f.postcc  Both ;
  135. : FCC.-  f.pre2  fj.-  f.postcc  Both ;
  136. : FCC.*  f.pre2  fj.*  f.postcc  Both ;
  137.  
  138. : FCC./  F./  CC.to.fpstat ;
  139.  
  140.  
  141. \ Conditionally compile floating ops with or without GetCC,
  142. \ or if interpreting just execute the function with GetCC.
  143.  
  144. : Fop.c/x  ( fop-cfa  fopcc-cfa -- )
  145.     compiling?
  146.     IF   fp-status? @   IF  nip cfa,  ELSE  drop cfa,  THEN
  147.     ELSE nip execute THEN ;
  148.  
  149. : F+  ' f.+  ' fcc.+  Fop.c/x  ;  immediate
  150. : F-  ' f.-  ' fcc.-  Fop.c/x  ;  immediate
  151. : F*  ' f.*  ' fcc.*  Fop.c/x  ;  immediate
  152. : F/  ' f./  ' fcc./  Fop.c/x  ;  immediate
  153.  
  154.  
  155. \ -------------------------- INT - Convert Floating Point to Integer
  156. Asm INT
  157.     move.b  tos,d1           Sign and exponent
  158.     bge.s   7$               Go handle positive case
  159.     clr.b   tos              Negative case, clear lsb
  160.     sub.b   #$C1,d1          Subtract off sign bit and bias+1
  161.     bmi.s   4$               Underflow, go return zero
  162.     sub.b   #$1F,d1          Make shift count
  163.     bpl.s   1$               Branch on probable overflow
  164.     neg.b   d1
  165.     lsr.l   d1,tos           Fix it and
  166.     neg.l   tos              make negative
  167.     bra.s   9$
  168. 1$: bne.s   2$               Branch on overflow
  169.     neg.l   tos              Check for max neg that can be fixed
  170.     bmi.s   9$               Was $ 800000E0 and is $80000000, so exit
  171. 2$: move.l  #$80000000,tos   Overflow neg infinite
  172. 3$: ori-ccr #2               Set overflow bit
  173.     bra.s   9$
  174. 4$: moveq.l #0,tos
  175.     bra.s   9$
  176. 5$: move.l  #$7FFFFFFF,tos   Overflow pos infinite
  177.     bra.s   3$
  178. 7$: clr.b   tos              Positive, clear lsb
  179.     sub.b   #$41,d1          Subtract off bias+1
  180.     bmi.s   4$               Branch on underflow
  181.     sub.b   #$1F,d1          Make shift count
  182.     bpl.s   5$               Branch on overflow
  183.     neg.b   d1
  184.     lsr.l   d1,tos           Fix pos number
  185. 9$: Forth{ both }
  186. End-Code
  187.  
  188. \ -------------------------- FLOAT - Convert Integer to Floating Point
  189. Asm FLOAT
  190.     moveq.l #$5F,d1          Positive start exponent
  191.     tst.l   tos
  192.     beq.s   9$               Zero in, zero out
  193.     bgt.s   2$               Go handle positive case
  194.     neg.l   tos              Make negative positive
  195.     bpl.s   1$               Go handle negative case
  196.     moveq.l #$E0,d1          $80000000 in, $800000E0 out
  197.     bra.s   4$
  198. 1$: moveq.l #$df,d1          Negative start exponet
  199.     cmp.l   #$7FFF,tos
  200.     bhi.s   3$               Avoid normalizing 16 high order 0 bits
  201.     swap    tos              Fast left shift 16 places
  202.     moveq.l #$cf,d1          And new negative start exponent
  203.     bra.s   3$               Go normalize
  204. 2$: cmp.l   #$7FFF,tos
  205.     bhi.s   3$               Avoid normalizing 16 high order 0 bits
  206.     swap    tos              Fast left shift 16 places
  207.     moveq.l #$4F,d1          and new positive start exponent
  208. 3$: add.l   tos,tos          Normalization
  209.     dbmi.w  d1,3$              loop
  210.     add.l   #$40,tos         Round result
  211.     bcc.s   4$               Branch if rounding did not overflow
  212.     roxr.l  #$1,tos          Else handle overflow caused by rounding
  213.     addq.l  #1,d1
  214. 4$: move.b  d1,tos           Stuff exponent and set condition code
  215. 9$: Forth{ both }
  216. End-Code
  217.  
  218. \ --------------------------- Floating Point Add .5 to values >= .5
  219. Asm >=.5+.5
  220.     move.b   tos,d0           Isolate exponent
  221.     bclr     #7,d0
  222.     sub.b    #$40,d0
  223.     blt.s    2$               Branch on too small to round
  224.     sub.b    #$17,d0
  225.     bgt.s    2$               Branch on too big to round
  226.     neg.b    d0               Make int .5 aligned with float .5
  227.     addq.b   #8,d0
  228.     moveq.l  #0,d1
  229.     bset     d0,d1
  230.     move.l   tos,d0
  231.     add.l    d1,tos           Add the int .5
  232.     bcc.s    1$
  233.     roxr.l   #1,tos           Handle overflow
  234.     addq.b   #1,d0
  235. 1$: move.b   d0,tos           Replace exponent
  236. 2$: Forth{ both }
  237. End-Code
  238.  
  239. \ --------------------------- FIX - Floating Point rounded INT
  240. max-inline @  90 max-inline !
  241.   : FIX  >=.5+.5  int  both ; 
  242. max-inline !
  243.  
  244.  
  245. \ --------------------------- Floating Point Multiply by 2.
  246. Asm F.2*
  247.     move.l  tos,d0
  248.     beq.s   2$                If zero, do nothing
  249.     addq.l  #1,tos            Increment exponent
  250.     eor.b   tos,d0            If sign bit changed, then overflow
  251.     bgt.s   1$                Branch on no overflow
  252.     subq.l  #1,tos            Get back original value
  253.     or.l    #$FFFFFF7F,tos    Max number with original sign bit
  254.     tst.b   tos               Set condition code
  255.     ori-ccr #2                Set overflow condition
  256.     bra.s   2$
  257. 1$: tst.b   tos               Set condition code
  258. 2$: Forth{ Inline }
  259. End-Code
  260.     
  261. : FCC.2*  F.2*  CC.To.FPStat  Both ;
  262.  
  263. : F2*  ' F.2*  ' FCC.2*  Fop.c/x  ; immediate
  264.  
  265.  
  266. \ --------------------------- Floating Point Divide by 2.
  267. Asm F.2/
  268.     move.l tos,d0
  269.     subq.l  #1,tos            Decrement exponent
  270.     eor.b   tos,d0            If sign bit changed, then underflow
  271.     bgt.s   1$                Branch if no underflow
  272.     moveq.l #0,tos            If underflow, return zero
  273. 1$: tst.b   tos               Set Condition Code
  274.     Forth{ Inline }
  275. End-Code
  276.  
  277. : FCC.2/  F.2/  CC.To.FPStat  Both ;
  278.  
  279. : F2/  ' F.2/  ' FCC.2/  Fop.c/x  ; immediate
  280.  
  281.  
  282. \ --------------------------- Floating Point Condition Checking
  283. : FP.Cond.Err
  284.   cr ." Floating point conditional used while FP-STATUS? is false" ;
  285.  
  286. \ If fp condition codes are being saved, then compile conditional test
  287. \ code or execute if interpreting, otherwise give error message.
  288.  
  289. : Fcond.c/x  ( test-cfa -- )
  290.     fp-status? @
  291.     if  compiling?  if  cfa,  else  execute  then
  292.     else fp.cond.err drop then ;
  293.  
  294. : FEQ  ' feq  fcond.c/x ; immediate
  295. : FLT  ' flt  fcond.c/x ; immediate
  296. : FGT  ' fgt  fcond.c/x ; immediate
  297. : FNE  ' fne  fcond.c/x ; immediate
  298. : FLE  ' fle  fcond.c/x ; immediate
  299. : FGE  ' fge  fcond.c/x ; immediate
  300. : FVS  ' fvs  fcond.c/x ; immediate
  301. : FVC  ' fvc  fcond.c/x ; immediate
  302.  
  303.  
  304. \ --------------------------- Floating Point Angular Conversions
  305. $ E52E,E146  Constant  Deg/Rad
  306. $ 8EFA,353B  Constant  Rad/Deg
  307.  
  308. : DEG>RAD rad/deg f* ;
  309. : RAD>DEG deg/rad f* ;
  310.