* FACT  (n)       
*                vs 1.20  28 Feb. 1993  (f.p. 0-50)
*
* factorial of a number, between 0 to 50
*
BP_INIT  EQU       $110

init     lea.l     define,a1
         movea.w   BP_INIT,a2
         jmp       (a2)
*
* FACT(n)
*
fact     cmpa.l    a3,a5          any parameters ?
         beq.s     bad_param
         movea.w   $112,a2        vector to get integers ..
         jsr       (a2)           CA.GTINT
         bne.s     bad_exit
         move.w    0(a1,a6.l),d0  fetch the parameter
         cmp.w     #0,d0          num < 0 ?
         bmi.s     out_range      Yes
         cmp.w     #50,d0         num > 50 ?
         bgt.s     overflow       Yes
         lea.l     fact_table,a1  a1 = pointer to factorials table
         mulu      #6,d0          scale for elements (each f.p. holds 6 bytes)
         adda.l    d0,a1
         move.w    0(a1),d4       retrieve the exponent
         move.l    2(a1),d5       retrieve the mantissa
*
* check there's enough space for the result : (6-2) bytes
*
normalised
         move.l   a1,$58(a6)        record current a1 limit
         moveq    #4,d1             No. of extra bytes needed
         move.w   $11A,a0           BV.CHRIX vector
         jsr      (a0)
         move.l   $58(a6),a1        get safe A1 value
         subq.w   #4,a1
         move.l   a1,$58(a6)        grab 4 more bytes safely
*
         move.l   d5,2(a1,a6.l)     stack mantissa
         move.w   d4,0(a1,a6.l)     stack exponent
         moveq    #2,d4             floating point result
         moveq    #0,d0
         rts
*
overflow  moveq    #-18,d0
          bra.s    bad_exit
out_range moveq    #-4,d0
          bra.s    bad_exit
bad_param moveq    #-15,d0         signal a BAD PARAMETER error
bad_exit  rts                      return the error code in d0
*
fact_table        dc.b    8,1,64,0,0,0    f.p. fact( 0 )
        dc.b    8,1,64,0,0,0    f.p. fact( 1 )
        dc.b    8,2,64,0,0,0    f.p. fact( 2 )
        dc.b    8,3,96,0,0,0    f.p. fact( 3 )
        dc.b    8,5,96,0,0,0    f.p. fact( 4 )
        dc.b    8,7,120,0,0,0    f.p. fact( 5 )
        dc.b    8,10,90,0,0,0    f.p. fact( 6 )
        dc.b    8,13,78,192,0,0    f.p. fact( 7 )
        dc.b    8,16,78,192,0,0    f.p. fact( 8 )
        dc.b    8,19,88,152,0,0    f.p. fact( 9 )
        dc.b    8,22,110,190,0,0    f.p. fact( 10 )
        dc.b    8,26,76,34,160,0    f.p. fact( 11 )
        dc.b    8,29,114,51,240,0    f.p. fact( 12 )
        dc.b    8,33,92,202,51,0    f.p. fact( 13 )
        dc.b    8,37,81,48,236,160    f.p. fact( 14 )
        dc.b    8,41,76,29,221,214    f.p. fact( 15 )
        dc.b    8,45,76,29,221,214    f.p. fact( 16 )
        dc.b    8,49,80,223,187,179    f.p. fact( 17 )
        dc.b    8,53,90,251,179,41    f.p. fact( 18 )
        dc.b    8,57,108,10,228,193    f.p. fact( 19 )
        dc.b    8,62,67,134,206,249    f.p. fact( 20 )
        dc.b    8,66,88,160,239,167    f.p. fact( 21 )
        dc.b    8,70,121,221,73,134    f.p. fact( 22 )
        dc.b    8,75,87,151,12,216    f.p. fact( 23 )
        dc.b    8,80,65,177,73,162    f.p. fact( 24 )
        dc.b    8,84,102,165,3,13    f.p. fact( 25 )
        dc.b    8,89,83,102,18,123    f.p. fact( 26 )
        dc.b    8,94,70,94,31,152    f.p. fact( 27 )
        dc.b    8,98,123,36,183,74    f.p. fact( 28 )
        dc.b    8,103,111,153,70,27    f.p. fact( 29 )
        dc.b    8,108,104,159,177,185    f.p. fact( 30 )
        dc.b    8,113,101,90,180,43    f.p. fact( 31 )
        dc.b    8,118,101,90,180,43    f.p. fact( 32 )
        dc.b    8,123,104,133,137,204    f.p. fact( 33 )
        dc.b    8,128,111,13,226,105    f.p. fact( 34 )
        dc.b    8,133,121,119,47,163    f.p. fact( 35 )
        dc.b    8,139,68,83,10,204    f.p. fact( 36 )
        dc.b    8,144,79,0,4,124    f.p. fact( 37 )
        dc.b    8,149,93,208,5,83    f.p. fact( 38 )
        dc.b    8,154,114,85,134,125    f.p. fact( 39 )
        dc.b    8,160,71,117,116,14    f.p. fact( 40 )
        dc.b    8,165,91,142,124,178    f.p. fact( 41 )
        dc.b    8,170,120,43,3,170    f.p. fact( 42 )
        dc.b    8,176,80,188,230,118    f.p. fact( 43 )
        dc.b    8,181,111,3,188,226    f.p. fact( 44 )
        dc.b    8,187,78,14,160,207    f.p. fact( 45 )
        dc.b    8,192,112,53,7,42    f.p. fact( 46 )
        dc.b    8,198,82,102,241,67    f.p. fact( 47 )
        dc.b    8,203,123,154,105,229    f.p. fact( 48 )
        dc.b    8,209,94,162,57,19    f.p. fact( 49 )
        dc.b    8,215,73,238,188,151    f.p. fact( 50 )
*
define   dc.w      0,0       No procedures
         dc.w      1
         dc.w      fact-*
         dc.b      4,'FACT'
         dc.w      0
         end