chiark - git - mdw - ssr/blob - StraySrc/Libraries/Sapphire/csapph/s/cmath

   1 ;
   2 ; cmath.s
   3 ;
   4 ; Standard maths routines for Sapphire
   5 ;
   6 ; © 1995 Straylight
   7 ;
   8
   9 ;----- Standard header ------------------------------------------------------
  10
  11                 GET     libs:header
  12 ;               GET     libs:swis
  13
  14                 GET     libs:stream
  15
  16 ;----- Macros ---------------------------------------------------------------
  17
  18                 MACRO
  19 $label          ONEARG
  20                 [       "$label"<>""
  21                 EXPORT  $label
  22                 ALIGN
  23 $label
  24                 ]
  25                 STMFD   R13!,{R0,R1}
  26                 LDFD    F0,[R13],#8
  27                 MEND
  28
  29                 MACRO
  30 $label          TWOARG
  31                 [       "$label"<>""
  32                 EXPORT  $label
  33                 ALIGN
  34 $label
  35                 ]
  36                 STMFD   R13!,{R0-R3}
  37                 LDFD    F0,[R13],#8
  38                 LDFD    F1,[R13],#8
  39                 MEND
  40
  41                 MACRO
  42 $label          UNOP    $op
  43 $label          ONEARG
  44                 $op.E   F0,F0
  45                 MOVS    PC,R14
  46                 MEND
  47
  48                 MACRO
  49                 CTOP
  50                 MOV     R1,#0
  51                 RFS     R12
  52                 WFS     R1
  53                 MEND
  54
  55                 MACRO
  56                 CBOT
  57                 RFS     R1
  58                 WFS     R12
  59                 TST     R1,#&0F
  60                 MOVEQS  PC,R14
  61                 B       cmath__error
  62                 MEND
  63
  64                 MACRO
  65                 COP     $op
  66                 CTOP
  67                 $op
  68                 CBOT
  69                 MEND
  70
  71                 MACRO
  72 $label          CUNOP   $op
  73 $label          ONEARG
  74                 COP     "$op.E F0,F0"
  75                 MEND
  76
  77                 MACRO
  78 $label          CBINOP  $op
  79 $label          TWOARG
  80                 COP     "$op.E F0,F0,F1"
  81                 MEND
  82
  83                 MACRO
  84                 WS      $addr,$reg,$tmp
  85                 IMPORT  |__sph_workoff|,WEAK
  86                 ALIGN
  87                 LDR     $reg,$addr
  88                 DCD     |__sph_workoff| + &E51B0004 + ($tmp<<12)
  89                 MEND
  90
  91 ;----- Error numbers --------------------------------------------------------
  92
  93                 ^       1
  94 EDOM            #       1
  95 ERANGE          #       1
  96
  97 ;----- Main code ------------------------------------------------------------
  98
  99                 AREA    |Sapphire$$Code|,CODE,READONLY
 100
 101                 ; --- Simple FP ops ---
 102                 ;
 103                 ; These map onto FP instructions in a simple way.  Some of
 104                 ; the simpler ops are actually inlined by the compiler
 105                 ; anyway.
 106
 107 sin             UNOP    SIN
 108 cos             UNOP    COS
 109 atan            UNOP    ATN
 110
 111 tan             CUNOP   TAN
 112 asin            CUNOP   ASN
 113 acos            CUNOP   ACS
 114
 115 atan2           TWOARG
 116                 COP     "POLE F0,F1,F0"
 117
 118 exp             CUNOP   EXP
 119 log             CUNOP   LGN
 120 log10           CUNOP   LOG
 121
 122 |__sapph_sqrt|  CUNOP   SQT
 123 pow             CBINOP  POW
 124
 125 fabs            UNOP    ABS
 126
 127 fmod            TWOARG
 128                 CTOP
 129                 DVFE    F2,F0,F1
 130                 RNDEZ   F2,F2
 131                 MUFE    F1,F2,F1
 132                 SUFE    F0,F0,F1
 133                 CBOT
 134
 135                 ; --- Rounding functions ---
 136
 137 ceil            ONEARG
 138                 RNDEP   F0,F0
 139                 MOVS    PC,R14
 140
 141 floor           ONEARG
 142                 RNDEM   F0,F0
 143                 MOVS    PC,R14
 144
 145 modf            ONEARG
 146                 RNDEZ   F1,F0
 147                 SUFE    F0,F0,F1
 148                 STFD    F1,[R2,#0]
 149                 MOVS    PC,R14
 150
 151                 ; --- Hyperbolic functions ---
 152
 153 sinh            ONEARG
 154                 CTOP
 155                 MNFE    F1,F0
 156                 EXPE    F0,F0
 157                 EXPE    F1,F1
 158                 SUFE    F0,F0,F1
 159                 DVFE    F0,F0,#2
 160                 CBOT
 161
 162 cosh            ONEARG
 163                 CTOP
 164                 MNFE    F1,F0
 165                 EXPE    F0,F0
 166                 EXPE    F1,F1
 167                 ADFE    F0,F0,F1
 168                 DVFE    F0,F0,#2
 169                 CBOT
 170
 171 tanh            ONEARG
 172                 CTOP
 173                 MNFE    F1,F0
 174                 EXPE    F0,F0
 175                 EXPE    F1,F1
 176                 ADFE    F2,F0,F1
 177                 SUFE    F0,F0,F1
 178                 DVFE    F0,F0,F2
 179                 CBOT
 180
 181                 ; --- Horrific FP-number-building functions ---
 182
 183                 EXPORT  frexp
 184 frexp           ROUT
 185
 186                 MOVS    R3,R0,LSL #1
 187                 CMPEQ   R1,#0
 188                 MOVNE   R3,R0,LSR #20
 189                 BICNE   R3,R3,#&800
 190                 ADDNE   R3,R3,#2
 191                 SUBNE   R3,R3,#1024
 192                 BICNE   R0,R0,#&40000000
 193                 BICNE   R0,R0,#&00100000
 194                 ORRNE   R0,R0,#&3FC00000
 195                 ORRNE   R0,R0,#&00200000
 196                 STR     R3,[R2,#0]
 197                 ONEARG
 198                 NRME    F0,F0
 199                 MOVS    PC,R14
 200
 201                 LTORG
 202
 203                 EXPORT  ldexp
 204 ldexp           ROUT
 205
 206                 ADD     R2,R2,#1024
 207                 SUB     R2,R2,#1
 208                 MOV     R2,R2,LSL #21
 209                 MOV     R2,R2,LSR #1
 210                 MOV     R3,#0
 211                 TWOARG
 212                 CTOP
 213                 MUFE    F0,F0,F1
 214                 CBOT
 215
 216                 LTORG
 217
 218                 ; --- Error handling ---
 219
 220 ; --- cmath__error ---
 221 ;
 222 ; On entry:     R1 == error status indicator
 223 ;
 224 ; On exit:      errno set up nicely
 225 ;
 226 ; Use:          Handles errors in maths routines.
 227
 228 cmath__error    ROUT
 229
 230                 TST     R1,#&3                  ;Check for IVO and DVZ
 231                 MOVNE   R0,#EDOM                ;Domain error
 232                 BNE     %50cmath__error         ;So return that then
 233
 234                 TST     R1,#&8                  ;Check for UFL condition
 235                 MVFNEE  F0,#0                   ;Underflowed -- zero result
 236                 MOVNE   R0,#ERANGE              ;And return a range error
 237                 BNE     %50cmath__error         ;And return the result
 238
 239                 CMFE    F0,#0                   ;Is result positive?
 240                 LDFGTD  F0,cmath__huge          ;Yes -- get positive huge
 241                 LDFLED  F0,cmath__nhuge         ;No -- get negative huge
 242                 MOV     R0,#ERANGE              ;And return a range error
 243
 244 50cmath__error
 245                 WS      cmath__wSpace,R12,R3    ;Find workspace location
 246                 STR     R0,[R12,R3]             ;Store the error value
 247                 MOVS    PC,R14                  ;And return to caller
 248
 249                 EXPORT  cmath__huge
 250 cmath__huge     DCD     &7FEFFFFF,-1
 251 cmath__nhuge    DCD     &FFEFFFFF,-1
 252
 253                 LTORG
 254
 255 ; --- cmath_errno ---
 256 ;
 257 ; On entry:     --
 258 ;
 259 ; On exit:      R0 == address of `errno'
 260 ;
 261 ; Use:          Finds the address of the `errno' variable.
 262
 263                 EXPORT  cmath_errno
 264 cmath_errno     ROUT
 265
 266                 WS      cmath__wSpace,R12,R0
 267                 ADD     R0,R12,R0
 268                 MOVS    PC,R14
 269
 270                 LTORG
 271
 272 cmath__wSpace   DCD     0
 273
 274 ;----- Workspace ------------------------------------------------------------
 275
 276                 ^       0,R12
 277 cmath__wStart   #       0
 278
 279 cmath__errno    #       4                       ;Global `errno' variable
 280
 281 cmath__wSize    EQU     {VAR}-cmath__wStart
 282
 283                 AREA    |Sapphire$$LibData|,CODE,READONLY
 284
 285                 DCD     cmath__wSize
 286                 DCD     cmath__wSpace
 287                 DCD     0
 288                 DCD     0
 289
 290 ;----- That's all, folks ----------------------------------------------------
 291
 292                 END