home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 8 / FreshFishVol8-CD1.bin / useful / dev / obero / oberon-a / source / oberonsys / divmod.asm < prev    next >
Encoding:
Assembly Source File  |  1994-08-08  |  7.5 KB  |  282 lines
  1. ****************************************************************************
  2. *
  3. *    $RCSfile: DIVMOD.asm $
  4. * Description: Runtime support for the Oberon-A compiler
  5. *
  6. *  Created by: fjc (Frank Copeland)
  7. *   $Revision: 1.3 $
  8. *     $Author: fjc $
  9. *       $Date: 1994/07/24 18:25:16 $
  10. *
  11. * Copyright © 1994, Frank Copeland.
  12. * This file is part of the Oberon-A Library.
  13. * See Oberon-A.doc for conditions of use and distribution.
  14. *
  15. * Log entries are at the end of the file.
  16. *
  17. ****************************************************************************
  18. *
  19. * This file contains the MC68000 source code for part of the runtime
  20. * support library of the Oberon-A compiler.  It contains the code to
  21. * perform division and modulus operations on 32-bit signed integers
  22. * (LONGINTs).
  23. *
  24. * Other parts of the runtime system may be found in the other files in
  25. * this directory.  The object files resulting from assembling these
  26. * files are concatenated to create OberonSys.lib.
  27. *
  28. * This code is by definition *not* re-entrant and is not suitable for
  29. * creating shared-code libraries.
  30. *
  31. * Acknowledgements
  32. * ----------------
  33. *
  34. * The 32-bit multiply and divide procedures are from the runtime
  35. * library of Patrick Quaid's PCQ freeware Pascal compiler, which in
  36. * turn came from the runtime library of Sozobon C.
  37. *
  38. **********************************************************************
  39.  
  40. ;---------------------------------------------------------------------
  41. ;    Program unit hunk name
  42.  
  43.      TTL OberonSys
  44.  
  45. ;---------------------------------------------------------------------
  46. ;    Imports
  47.  
  48.      INCLUDE   "OberonSys.i"
  49.  
  50. **********************************************************************
  51.  
  52. **********
  53. * lmath.s
  54. **********
  55. * Copyright (c) 1988 by Sozobon, Limited.  Author: Johann Ruegg
  56. *
  57. * Permission is granted to anyone to use this software for any purpose
  58. * on any computer system, and to redistribute it freely, with the
  59. * following restrictions:
  60. * 1) No charge may be made other than reasonable charges for reproduction.
  61. * 2) Modified versions must be clearly marked as such.
  62. * 3) The authors are not responsible for any harmful consequences
  63. *    of using this software, even if they result from defects in it.
  64. *
  65.  
  66. *       For PCQ Pascal:
  67. *            These are the 32-bit math functions from Sozobon-C,
  68. *       as noted above.  I changed the names of the routines to
  69. *       be more similar to the rest of my library, and handle the
  70. *       divide by zero condition differently.  Other than that I
  71. *       haven't changed the code a bit.
  72.  
  73. *       For Oberon-A:
  74. *            I have changed the names (again) and modified the
  75. *       routines to accept parameters passed in registers instead of
  76. *       on the stack, in keeping with the conventions I use in the
  77. *       rest of the compiler.
  78.  
  79. **********************************************************************
  80.  
  81.      ;----------------------------------------------------------------
  82.      ; PROCEDURE OberonSys_DIV
  83.      ;   l1 {D0} : LONGINT;
  84.      ;   l2 {D1} : LONGINT)
  85.      ; : LONGINT;
  86.      ;
  87.      ; Calculates l1 DIV l2, returning the result in D0.
  88.      ;----------------------------------------------------------------
  89.  
  90.      SECTION OberonSys,CODE
  91.  
  92.      XDEF      OberonSys_DIV
  93.  
  94. OberonSys_DIV:
  95.  
  96.         movem.l d2-d5,-(a7)     ; save registers
  97.         tst.l   d0
  98.         smi     d4
  99.         bpl     ld1
  100.         neg.l   d0
  101. ld1:
  102.         tst.l   d1
  103.         smi     d5
  104.         bpl     ld2
  105.         neg.l   d1
  106. ld2:
  107.         bsr     i_ldiv          /* d0 = d0/d1, d1 = d0%d1 */
  108.         cmp.b   d4,d5
  109.         beq     ld3
  110.         neg.l   d0
  111. ld3:
  112. ;        tst.b   d4
  113. ;        beq     ld4
  114. ;        neg.l   d1
  115. ;ld4:
  116.         movem.l (a7)+,d2-d5
  117.         rts
  118.  
  119. ;---------------------------------------------------------------------
  120.  
  121.      ;----------------------------------------------------------------
  122.      ; PROCEDURE OberonSys_MOD
  123.      ;   l1 {D0} : LONGINT;
  124.      ;   l2 {D1} : LONGINT)
  125.      ; : LONGINT;
  126.      ;
  127.      ; Calculates l1 MOD l2, returning the result in D0.
  128.      ;----------------------------------------------------------------
  129.  
  130.      SECTION OberonSys,CODE
  131.  
  132.      XDEF      OberonSys_MOD
  133.  
  134. OberonSys_MOD:
  135.  
  136. ;        movem.l d2-d5,-(a7)     ; save registers
  137.         movem.l d2-d4,-(a7)     ; save registers
  138.         tst.l   d0
  139.         smi     d4
  140.         bpl     lmd1
  141.         neg.l   d0
  142. lmd1:
  143. ;        tst.l   d1
  144. ;        smi     d5
  145. ;        bpl     lmd2
  146. ;        neg.l   d1
  147. ;lmd2:
  148.         bsr     i_ldiv          /* d0 = d0/d1, d1 = d0%d1 */
  149. ;        cmp.b   d4,d5
  150. ;        beq     lmd3
  151. ;        neg.l   d0
  152. ;lmd3:
  153.         tst.b   d4
  154.         beq     lmd4
  155.         neg.l   d1
  156. lmd4:
  157.         move.l  d1,d0
  158. ;        movem.l (a7)+,d2-d5
  159.         movem.l (a7)+,d2-d4
  160.         rts
  161.  
  162. ;---------------------------------------------------------------------
  163.  
  164.      SECTION OberonSys,CODE
  165.  
  166.      XREF OberonSys_CLEANUP
  167.  
  168. *A in d0, B in d1, return A/B in d0, A%B in d1
  169. i_ldiv:
  170.         tst.l   d1
  171.         bne.s   nz1
  172.  
  173. *       divide by zero
  174.         LEA     OberonSys_VAR,A5
  175.         move.l  #OS_ZeroDiv,OS_returnCode(A5)  ;     HALT (ZeroDiv)
  176.         bra     OberonSys_CLEANUP
  177. nz1:
  178.         cmp.l   d1,d0
  179.         bhi     norm
  180.         beq     is1
  181. *       A<B, so ret 0, rem A
  182.         move.l  d0,d1
  183.         clr.l   d0
  184.         rts
  185. *       A==B, so ret 1, rem 0
  186. is1:
  187.         moveq.l #1,d0
  188.         clr.l   d1
  189.         rts
  190. *       A>B and B is not 0
  191. norm:
  192.         cmp.l   #1,d1
  193.         bne.s   not1
  194. *       B==1, so ret A, rem 0
  195.         clr.l   d1
  196.         rts
  197. *  check for A short (implies B short also)
  198. not1:
  199.         cmp.l   #$ffff,d0
  200.         bhi     slow
  201. *  A short and B short -- use 'divu'
  202.         divu    d1,d0           /* d0 = REM:ANS */
  203.         swap    d0              /* d0 = ANS:REM */
  204.         clr.l   d1
  205.         move.w  d0,d1           /* d1 = REM */
  206.         clr.w   d0
  207.         swap    d0
  208.         rts
  209. * check for B short
  210. slow:
  211.         cmp.l   #$ffff,d1
  212.         bhi     slower
  213. * A long and B short -- use special stuff from gnu
  214.         move.l  d0,d2
  215.         clr.w   d2
  216.         swap    d2
  217.         divu    d1,d2           /* d2 = REM:ANS of Ahi/B */
  218.         clr.l   d3
  219.         move.w  d2,d3           /* d3 = Ahi/B */
  220.         swap    d3
  221.  
  222.         move.w  d0,d2           /* d2 = REM << 16 + Alo */
  223.         divu    d1,d2           /* d2 = REM:ANS of stuff/B */
  224.  
  225.         move.l  d2,d1
  226.         clr.w   d1
  227.         swap    d1              /* d1 = REM */
  228.  
  229.         clr.l   d0
  230.         move.w  d2,d0
  231.         add.l   d3,d0           /* d0 = ANS */
  232.         rts
  233. *       A>B, B > 1
  234. slower:
  235.         move.l  #1,d2
  236.         clr.l   d3
  237. moreadj:
  238.         cmp.l   d0,d1
  239.         bhi.s   adj
  240.         add.l   d2,d2
  241.         add.l   d1,d1
  242.         bpl     moreadj
  243. * we shifted B until its >A or sign bit set
  244. * we shifted #1 (d2) along with it
  245. adj:
  246.         cmp.l   d0,d1
  247.         bhi.s   ltuns
  248.         or.l    d2,d3
  249.         sub.l   d1,d0
  250. ltuns:
  251.         lsr.l   #1,d1
  252.         lsr.l   #1,d2
  253.         bne     adj
  254. * d3=answer, d0=rem
  255.         move.l  d0,d1
  256.         move.l  d3,d0
  257.         rts
  258.  
  259. ;---------------------------------------------------------------------
  260.  
  261.      END  ; OberonSys
  262.  
  263. **********************************************************************
  264. *
  265. * $Log: DIVMOD.asm $
  266. * Revision 1.3  1994/07/24  18:25:16  fjc
  267. * - Changed code for calling HALT().
  268. *
  269. * Revision 1.2  1994/05/12  20:31:15  fjc
  270. * - Prepared for release
  271. *
  272. * Revision 1.1  1994/01/15  18:31:52  fjc
  273. * Start of revision control
  274. *
  275. * (12 Jan 1994) Modified to assemble with PhxAss instead of A68K
  276. * ( 9 Jul 1993) Changed return code to OS_ZeroDiv.
  277. * (29 May 1993) Split OberonSys.asm into several files to create
  278. *               OberonSys.lib.
  279. *
  280. **********************************************************************
  281.  
  282.