home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0010 - 0019 / ibm0010-0019 / ibm0010.tar / ibm0010 / QC25-10.ZIP / SAMPLES / MATH.AS$ / MATH.bin
Encoding:
Text File  |  1989-04-27  |  10.6 KB  |  341 lines
  1.     .MODEL small, c
  2.     INCLUDE demo.inc
  3.     .CODE
  4.  
  5. ;* AddLong - Adds two double-word (long) integers.
  6. ;*
  7. ;* Shows:   Instructions - add       adc
  8. ;*
  9. ;* Params:  long1 - First integer
  10. ;*        long2 - Second integer
  11. ;*
  12. ;* Return:  Sum as long integer
  13.  
  14. AddLong PROC \
  15.     long1:DWORD, long2:DWORD
  16.  
  17.     mov    ax, WORD PTR long1[0]    ; AX = low word, long1
  18.     mov    dx, WORD PTR long1[2]    ; DX = high word, long1
  19.     add    ax, WORD PTR long2[0]    ; Add low word, long2
  20.     adc    dx, WORD PTR long2[2]    ; Add high word, long2
  21.     ret                ; Result returned as DX:AX
  22.  
  23. AddLong ENDP
  24.  
  25.  
  26.  
  27.  
  28. ;* SubLong - Subtracts a double-word (long) integer from another.
  29. ;*
  30. ;* Shows:   Instructions -  sub     sbb
  31. ;*
  32. ;* Params:  long1 - First integer
  33. ;*        long2 - Second integer
  34. ;*
  35. ;* Return:  Difference as long integer
  36.  
  37. SubLong PROC \
  38.     long1:DWORD, long2:DWORD
  39.  
  40.     mov    ax, WORD PTR long1[0]    ; AX = low word, long1
  41.     mov    dx, WORD PTR long1[2]    ; DX = high word, long1
  42.     sub    ax, WORD PTR long2[0]    ; Subtract low word, long2
  43.     sbb    dx, WORD PTR long2[2]    ; Subtract high word, long2
  44.     ret                ; Result returned as DX:AX
  45.  
  46. SubLong ENDP
  47.  
  48.  
  49. ;* MulLong - Multiplies two unsigned double-word (long) integers. The
  50. ;* procedure allows for a product of twice the length of the multipliers,
  51. ;* thus preventing overflows. The result is copied into a 4-word data area
  52. ;* and a pointer to the data area is returned.
  53. ;*
  54. ;* Shows:   Instruction - mul
  55. ;*
  56. ;* Params:  long1 - First integer (multiplicand)
  57. ;*        long2 - Second integer (multiplier)
  58. ;*
  59. ;* Return:  Pointer to quadword result
  60.  
  61.     .DATA
  62.     PUBLIC result
  63. result    DQ    WORD PTR ?        ; Result from MulLong 
  64.  
  65.     .CODE
  66. MulLong PROC \
  67.     long1:DWORD, long2:DWORD
  68.  
  69.     mov    ax, WORD PTR long2[2]    ; Multiply long2 high word
  70.     mul    WORD PTR long1[2]    ;   by long1 high word
  71.     mov    WORD PTR result[4], ax
  72.     mov    WORD PTR result[6], dx
  73.  
  74.     mov    ax, WORD PTR long2[2]    ; Multiply long2 high word
  75.     mul    WORD PTR long1[0]    ;   by long1 low word
  76.     mov    WORD PTR result[2], ax
  77.     add    WORD PTR result[4], dx
  78.     adc    WORD PTR result[6], 0    ; Add any remnant carry
  79.  
  80.     mov    ax, WORD PTR long2[0]    ; Multiply long2 low word
  81.     mul    WORD PTR long1[2]    ;   by long1 high word
  82.     add    WORD PTR result[2], ax
  83.     adc    WORD PTR result[4], dx
  84.     adc    WORD PTR result[6], 0    ; Add any remnant carry
  85.  
  86.     mov    ax, WORD PTR long2[0]    ; Multiply long2 low word
  87.     mul    WORD PTR long1[0]    ;   by long1 low word
  88.     mov    WORD PTR result[0], ax
  89.     add    WORD PTR result[2], dx
  90.     adc    WORD PTR result[4], 0    ; Add any remnant carry
  91.  
  92.     mov    ax, OFFSET result    ; Return pointer
  93.     mov    dx, @data        ;   to result
  94.     ret
  95.  
  96. MulLong ENDP
  97.  
  98.  
  99. ;* ImulLong - Multiplies two signed double-word integers. Because the imul
  100. ;* instruction (illustrated here) treats each word as a signed number, its
  101. ;* use is impractical when multiplying multi-word values. Thus the technique
  102. ;* used in the MulLong procedure can't be adopted here. Instead, ImulLong
  103. ;* is broken into three sections arranged in ascending order of computational
  104. ;* overhead. The procedure tests the values of the two integers and selects
  105. ;* the section that involves the minimum required effort to multiply them.
  106. ;*
  107. ;* Shows:   Instruction - imul
  108. ;*
  109. ;* Params:  long1 - First integer (multiplicand)
  110. ;*        long2 - Second integer (multiplier)
  111. ;*
  112. ;* Return:  Result as long integer
  113.  
  114. ImulLong PROC \
  115.     USES si, \
  116.     long1:DWORD, long2:DWORD
  117.  
  118. ; Section 1 tests for integers in the range of 0 to 65,535. If both
  119. ; numbers are within these limits, they're treated as unsigned short
  120. ; integers.
  121.  
  122. sect1:    mov    ax, WORD PTR long2[0]    ; AX = low word of long2
  123.     mov    dx, WORD PTR long2[2]    ; DX = high word of long2
  124.     mov    bx, WORD PTR long1[0]    ; BX = low word of long1
  125.     mov    cx, WORD PTR long1[2]    ; CX = high word of long1
  126.     or    dx, dx            ; Both high words zero?
  127.     jnz    sect2            ; No?  Go to section 2
  128.     or    cx, cx
  129.     jnz    sect2
  130.     mul    bx            ; Yes?    Multiply the low words
  131.     jmp    SHORT exit        ;   and exit section 1
  132.  
  133. ; Section 2 tests for integers in the range of -32,768 to 32,767. If
  134. ; both numbers are within these limits, they're treated as signed short
  135. ; integers.
  136.  
  137. sect2:    push    ax            ; Save long2 low word
  138.     push    bx            ; Save long1 low word
  139.     or    dx, dx            ; High word of long2 = 0?
  140.     jnz    @F            ; No?  Test for negative
  141.     test    ah, 80h         ; Low word of long2 in range?
  142.     jz    skip1            ; Yes?    long2 ok, so test long1
  143.     jmp    SHORT sect3        ; No?  Go to section 3
  144. @@:    cmp    dx, 0FFFFh        ; Empty with sign flag set?
  145.     jne    sect3            ; No?  Go to section 3
  146.     test    ah, 80h         ; High bit set in low word?
  147.     jz    sect3            ; No?  Low word is too high
  148.  
  149. skip1:    or    cx, cx            ; High word of long1 = 0?
  150.     jnz    @F            ; No?  Test for negative
  151.     test    bh, 80h         ; Low word of long1 in range?
  152.     jz    skip2            ; Yes?    long1 ok, so use sect 2
  153.     jmp    SHORT sect3        ; No?  Go to section 3
  154. @@:    cmp    cx, 0FFFFh        ; Empty with sign flag set?
  155.     jne    sect3            ; No?  Go to section 3
  156.     test    bh, 80h         ; High bit set in low word?
  157.     jz    sect3            ; No?  Low word is too high
  158.  
  159. skip2:    imul    bx            ; Multiply low words
  160.     pop    bx            ; Clean stack
  161.     pop    bx
  162.     jmp    SHORT exit        ; Exit section 2
  163.  
  164. ; Section 3 involves the most computational overhead. It treats the two
  165. ; numbers as signed long (double-word) integers.
  166.  
  167. sect3:    pop    bx            ; Recover long1 low word
  168.     pop    ax            ; Recover long2 low word
  169.     mov    si, dx            ; SI = long2 high word
  170.     push    ax            ; Save long2 low word
  171.     mul    cx            ; long1 high word x long2 low word
  172.     mov    cx, ax            ; Accumulate products in CX
  173.     mov    ax, bx            ; AX = low word of long1
  174.     mul    si            ; Multiply by long2 high word
  175.     add    cx, ax            ; Add to previous product
  176.     pop    ax            ; Recover long2 low word
  177.     mul    bx            ; Multiply by long1 low word
  178.     add    dx, cx            ; Add to product high word
  179.  
  180. exit:    ret                ; Return result as DX:AX
  181.  
  182. ImulLong ENDP
  183.  
  184.  
  185. ;* DivLong - Divides an unsigned long integer by an unsigned short integer.
  186. ;* The procedure does not check for overflow or divide-by-zero.
  187. ;*
  188. ;* Shows:   Instruction -  div
  189. ;*
  190. ;* Params:  long1 - First integer (dividend)
  191. ;*        short2 - Second integer (divisor)
  192. ;*        remn - Pointer to remainder
  193. ;*
  194. ;* Return:  Quotient as short integer
  195.  
  196. DivLong PROC \
  197.     USES di, \
  198.     long1:DWORD, short2:WORD, remn:PTR WORD
  199.  
  200.     mov    ax, WORD PTR long1[0]    ; AX = low word of dividend
  201.     mov    dx, WORD PTR long1[2]    ; DX = high word of dividend
  202.     div    short2            ; Divide by short integer
  203.     LoadPtr es, di, remn        ; Point ES:DI to remainder
  204.     mov    es:[di], dx        ; Copy remainder
  205.     ret                ; Return with AX = quotient
  206.  
  207. DivLong ENDP
  208.  
  209.  
  210. ;* IdivLong - Divides a signed long integer by a signed short integer.
  211. ;* The procedure does not check for overflow or divide-by-zero.
  212. ;*
  213. ;* Shows:   Instruction - idiv
  214. ;*
  215. ;* Params:  long1 - First integer (dividend)
  216. ;*        short2 - Second integer (divisor)
  217. ;*        remn - Pointer to remainder
  218. ;*
  219. ;* Return:  Quotient as short integer
  220.  
  221. IdivLong PROC \
  222.     USES di, \
  223.     long1:DWORD, short2:WORD, remn:PTR WORD
  224.  
  225.     mov    ax, WORD PTR long1[0]    ; AX = low word of dividend
  226.     mov    dx, WORD PTR long1[2]    ; DX = high word of dividend
  227.     idiv    short2            ; Divide by short integer
  228.     LoadPtr es, di, remn        ; ES:DI = remainder
  229.     mov    es:[di], dx        ; Copy remainder
  230.     ret                ; Return with AX = quotient
  231.  
  232. IdivLong ENDP
  233.  
  234.  
  235. ;* Quadratic - Solves for the roots of a quadratic equation of form
  236. ;*              A*x*x + B*x + C = 0
  237. ;* using floating-point instructions. This procedure requires either a math
  238. ;* coprocessor or emulation code. If executing within the QuickAssembler
  239. ;* environment, emulation is automatically provided if a coprocessor is not
  240. ;* installed. If executing from the QCL command line, the /FPi switch must
  241. ;* be specified if a coprocessor is not installed. For example, to create
  242. ;* the MATHDEMO.EXE example program with floating-point emulation, enter the
  243. ;* following line:
  244. ;*           QCL /Cx mathdemo.c /FPi math.asm common.asm
  245. ;*
  246. ;* Shows:   Instructions - sahf     fld1     fld     fadd     fmul
  247. ;*               fxch     fsubr    fchs    fsubp    fstp
  248. ;*               fst        fdivr    fwait   ftst
  249. ;*
  250. ;* Params:  a - Constant for 2nd-order term
  251. ;*        b - Constant for 1st-order term
  252. ;*        c - Equation constant
  253. ;*        r1 - Pointer to 1st root
  254. ;*        r2 - Pointer to 2nd root
  255. ;*
  256. ;* Return:  Short integer with return code
  257. ;*        0 if both roots found
  258. ;*        1 if single root (placed in r1)
  259. ;*        2 if indeterminate
  260.  
  261. Quadratic PROC \
  262.     USES ds di si, \
  263.     a:DWORD, b:DWORD, c:DWORD, r1:PTR DWORD, r2:PTR DWORD
  264.  
  265.     LOCAL status:WORD        ; Intermediate status
  266.  
  267.     LoadPtr es, di, r1        ; ES:DI points to 1st root
  268.     LoadPtr ds, si, r2        ; DS:SI points to 2nd root
  269.     sub    bx, bx            ; Clear error code
  270.     fld1                ; Load top of stack with 1
  271.     fadd    st, st            ; Double it to make 2
  272.     fld    st            ; Copy to next register
  273.     fmul    a            ; ST register = 2a
  274.     ftst                ; Test current ST value
  275.     fstsw    status            ; Copy status to local word
  276.     fwait                ; Ensure coprocessor is done
  277.     mov    ax, status        ; Copy status into AX
  278.     sahf                ; Load flag register
  279.     jnz    @F            ; If C3 set, a = 0, in which case
  280.                     ;   solution is x = -c / b
  281.     fld    b            ; Load b parameter
  282.     ftst                ; Test current ST value
  283.     fstsw    status            ; Copy status to local word
  284.     fwait                ; Ensure coprocessor is done
  285.     mov    ax, status        ; Copy status into AX
  286.     sahf                ; Load flag register
  287.     jz    exit2            ; If C3 set, b = 0, so don't divide
  288.     fld    st            ; Copy b to next register
  289.     fld    c            ; Load C parameter
  290.     fchs                ; Reverse sign
  291.     fxch                ; Exchange ST and ST(1)
  292.     fdiv                ; Divide c by b
  293.     fst    DWORD PTR es:[di]    ; Copy result
  294.     jmp    SHORT exit1        ; Return with code = 1
  295.  
  296. @@:    fmul    st(1), st        ; ST(1) register = 4a
  297.     fxch                ; Exchange ST and ST(1)
  298.     fmul    c            ; ST register = 4ac
  299.     ftst                ; Test current ST value
  300.     fstsw    status            ; Copy status to local word
  301.     fwait                ; Ensure coprocessor is done
  302.     mov    ax, status        ; Copy status into AX
  303.     sahf                ; Load flag register
  304.     jp    exit2            ; If C2 set, 4*a*c is infinite
  305.  
  306.     fld    b            ; Else load b parameter
  307.     fmul    st, st            ; Square it; ST register = b*b
  308.     fsubr                ; ST register = b*b - 4*a*c
  309.     ftst                ; Test current ST value
  310.     fstsw    status            ; Copy status to local word
  311.     fwait                ; Ensure coprocessor is done
  312.     mov    ax, status        ; Copy status into AX
  313.     sahf                ; Load flag register
  314.     jc    exit2            ; If C0 set, b*b < 4ac
  315.     jnz    @F            ; If C3 set, b*b = 4ac, in which
  316.     inc    bx            ;   case only 1 root so set flag
  317.  
  318. @@:    fsqrt                ; Get square root
  319.     fld    b            ; Load b parameter
  320.     fchs                ; Reverse sign
  321.     fxch                ; Exchange ST and ST1
  322.     fld    st            ; Copy square root to next reg
  323.     fadd    st, st(2)        ; ST = -b + sqrt(b*b - 4*a*c)
  324.     fxch                ; Exchange ST and ST1
  325.     fsubp    st(2), st        ; ST = -b - sqrt(b*b - 4*a*c)
  326.  
  327.     fdiv    st, st(2)        ; Divide 1st dividend by 2*a
  328.     fstp    WORD PTR es:[di]    ; Copy result, pop stack
  329.     fdivr                ; Divide 2nd dividend by 2*a
  330.     fstp    WORD PTR ds:[si]    ; Copy result, pop stack
  331.     jmp    SHORT exit        ; Return with code
  332.  
  333. exit2:    inc    bx            ; Error code = 2 for indeterminancy
  334. exit1:    inc    bx            ; Error code = 1 for single root
  335. exit:    mov    ax, bx
  336.     ret
  337.  
  338. Quadratic ENDP
  339.  
  340.     END
  341.