![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to mp.s CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / pari-2.2 / src / kernel / m68k|
Return to mp.s CVS log | Up to [local] / OpenXM_contrib / pari-2.2 / src / kernel / m68k |
1.1 ! noro 1: # $Id: mp.s,v 1.2 2000/11/03 21:00:25 karim Exp $
! 2: #
! 3: # Copyright (C) 2000 The PARI group.
! 4: #
! 5: # This file is part of the PARI/GP package.
! 6: #
! 7: # PARI/GP is free software; you can redistribute it and/or modify it under the
! 8: # terms of the GNU General Public License as published by the Free Software
! 9: # Foundation. It is distributed in the hope that it will be useful, but WITHOUT
! 10: # ANY WARRANTY WHATSOEVER.
! 11: #
! 12: # Check the License for details. You should have received a copy of it, along
! 13: # with the package; see the file 'COPYING'. If not, write to the Free Software
! 14: # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. */
! 15:
! 16: #*******************************************************************#
! 17: #===================================================================#
! 18: #* *#
! 19: #= oooooooooo ooooo oooooooooo ooooo =#
! 20: #* ooooooooooo ooooooooo ooooooooooo ooo *#
! 21: #* ooo ooo ooo ooo ooo ooo ooo *#
! 22: #= ooo ooo ooo ooo ooo ooo ooo =#
! 23: #* ooooooooooo ooooooooooo oooooooooo ooo *#
! 24: #= oooooooooo ooooooooooo ooooooooooo ooo =#
! 25: #* ooo ooo ooo ooo ooo ooo *#
! 26: #= ooo ooo ooo ooo ooo ooo =#
! 27: #* ooooo ooooo ooooo ooooo ooooo ooooo *#
! 28: #* *#
! 29: #= =#
! 30: #* version numero 2 *#
! 31: #* *#
! 32: #= commentee =#
! 33: #* *#
! 34: #= fichier cree le 22 sept. 1987 =#
! 35: #* *#
! 36: #= par =#
! 37: #* *#
! 38: #= christian batut , henri cohen , michel olivier =#
! 39: #* *#
! 40: #= """""""""""""""""""""""""""""""""""""""""""""" =#
! 41: #* *#
! 42: #===================================================================#
! 43: #*******************************************************************#
! 44: #-------------------------------------------------------------------#
! 45: # Notations : #
! 46: # T = type ( S , I , ou R ). #
! 47: # R = type reel. #
! 48: # S = type entier court ( long du C). #
! 49: # P = p-adique. #
! 50: # #
! 51: # L = longueur de la mantisse pour un reel ; #
! 52: # longueur de la mantisse effective pour un entier#
! 53: # l = longueur totale du nombre avec codage. #
! 54: # le= longueur effective totale de l'entier avec code #
! 55: # on doit avoir : l <= 2^15-1. #
! 56: # #
! 57: # exp = exposant non biaise d'un reel. #
! 58: # fexp= exposant biaise ( fexp = exp + 2^23 ). #
! 59: # on doit avoir : -2^23 <= exp < 2^23 #
! 60: # fvalp=valuation p-adique biaisee d'un p-adique. #
! 61: # ( fvalp = valuation + 2^15 ) #
! 62: #-------------------------------------------------------------------#
! 63: #-------------------------------------------------------------------#
! 64: # Conventions : #
! 65: # Tous les sous programmes creent la place necessaire #
! 66: # pour stocker le resultat , a l'exception des #
! 67: # programmes d'affectation et d'echange , ainsi que #
! 68: # des programmes dont le nom se termine par la lettre #
! 69: # "z" . On entre dans ces derniers avec une zone creee#
! 70: # dans la pile PARI ou le resultat est range. #
! 71: # #
! 72: # Le nombre reel 0 s'ecrit avec mantisse non #
! 73: # significative;le deuxieme lgmot code contient #
! 74: # -32*L + (2^23) ou L est la longueur de la mantisse #
! 75: # #
! 76: # Les registres a0,a1,d0,d1 sont en general utilises #
! 77: # par les programmes et ne sont pas restaures a leurs #
! 78: # valeurs d'entree.Tous les autres sont sauvegardes. #
! 79: # #
! 80: # Les objets utilises par PARI sont crees dans une #
! 81: # pile dite dans la suite "pile PARI",pointee par #
! 82: # _avma. #
! 83: #-------------------------------------------------------------------#
! 84:
! 85: affer1 = 23
! 86: affer2 = 24
! 87: affer3 = 25
! 88: affer4 = 26
! 89: affer5 = 27
! 90: shier1 = 28
! 91: shier2 = 29
! 92: truer1 = 30
! 93: truer2 = 31
! 94: adder1 = 32
! 95: adder2 = 33
! 96: adder3 = 34
! 97: adder4 = 35
! 98: adder5 = 36
! 99: muler1 = 37
! 100: muler2 = 38
! 101: muler3 = 39
! 102: muler4 = 40
! 103: muler5 = 41
! 104: muler6 = 42
! 105: diver1 = 43
! 106: diver2 = 44
! 107: diver3 = 45
! 108: diver4 = 46
! 109: diver5 = 47
! 110: diver6 = 48
! 111: diver7 = 49
! 112: diver8 = 50
! 113: diver9 = 51
! 114: diver10 = 52
! 115: diver11 = 53
! 116: diver12 = 54
! 117: divzer1 = 55
! 118: dvmer1 = 56
! 119: moder1 = 57
! 120: reser1 = 58
! 121: arier1 = 59
! 122: arier2 = 60
! 123: errpile = 61
! 124:
! 125: .text
! 126:
! 127: .globl _cget,_cgetg,_cgeti,_cgetr
! 128: .globl _mpaff,_affsz,_affsi,_affsr,_affii,_affir
! 129: .globl _affrs,_affri,_affrr
! 130: .globl _stoi,_itos
! 131: .globl _mptrunc,_mptruncz,_mpent,_mpentz
! 132: .globl _vals,_vali
! 133: .globl _mpshift,_mpshiftz,_shifts,_shifti,_shiftr
! 134: .globl _mpcmp,_cmpsi,_cmpsr,_cmpis,_cmpii,_cmpir
! 135: .globl _cmprs,_cmpri,_cmprr
! 136: .globl _mpadd,_addss,_addsi,_addsr,_addii,_addir,_addrr
! 137: .globl _mpaddz,_addssz,_addsiz,_addsrz,_addiiz,_addirz,_addrrz
! 138: .globl _mpsub,_subss,_subsi,_subsr,_subis,_subii,_subir
! 139: .globl _subrs,_subri,_subrr
! 140: .globl _mpsubz,_subssz,_subsiz,_subsrz,_subisz,_subiiz,_subirz
! 141: .globl _subrsz,_subriz,_subrrz
! 142: .globl _mpmul,_mulss,_mulsi,_mulsr,_asmmulii,_mulir,_mulrr
! 143: .globl _mpmulz,_mulssz,_mulsiz,_mulsrz,_muliiz,_mulirz,_mulrrz
! 144: .globl _dvmdss,_dvmdsi,_dvmdis,_asmdvmdii
! 145: .globl _mpdvmdz,_dvmdssz,_dvmdsiz,_dvmdisz,_dvmdiiz
! 146: .globl _mpdiv,_divss,_divsi,_divsr,_divis,_divii,_divir
! 147: .globl _divrs,_divri,_divrr
! 148: .globl _mpdivis,_divise
! 149: .globl _mpdivz,_divssz,_divsiz,_divsrz,_divisz,_diviiz,_divirz
! 150: .globl _divrsz,_divriz,_divrrz
! 151: .globl _mpinvz,_mpinvsr,_mpinvir,_mpinvrr
! 152: .globl _modss,_modsi,_modis,_modii
! 153: .globl _mpmodz,_modssz,_modsiz,_modisz,_modiiz
! 154: .globl _resss,_ressi,_resis,_resii
! 155: .globl _mpresz,_resssz,_ressiz,_resisz,_resiiz
! 156: .globl _addsii,_mulsii,_divisii
! 157:
! 158: #*******************************************************************#
! 159: #*******************************************************************#
! 160: #** **#
! 161: #** PROGRAMMES DE GESTION DE LA MEMOIRE PARI **#
! 162: #** **#
! 163: #*******************************************************************#
! 164: #*******************************************************************#
! 165:
! 166:
! 167:
! 168: #===================================================================#
! 169: # #
! 170: # Allocation memoire dans pile PARI en C #
! 171: # #
! 172: # entree : a7@(4) contient la longueur totale a attribuer #
! 173: # sortie : d0 pointe sur un type I ou R #
! 174: # d1 et a1 sont inutilises #
! 175: # #
! 176: #===================================================================#
! 177:
! 178: _cget: movl sp@(4),d0
! 179: bsr get
! 180: movl a0,d0
! 181: rts
! 182:
! 183: _cgetg: movl sp@(8),d0 | a7@(8) contient le type
! 184: rorl #8,d0
! 185: movw sp@(6),d0
! 186: bsr get
! 187: movl a0,d0
! 188: rts
! 189:
! 190: _cgeti: movl sp@(4),d0
! 191: bsr geti
! 192: movl a0,d0
! 193: rts
! 194:
! 195: _cgetr: movl sp@(4),d0
! 196: bsr getr
! 197: movl a0,d0
! 198: rts
! 199:
! 200: #===================================================================#
! 201: # #
! 202: # Allocation memoire dans pile PARI #
! 203: # #
! 204: # entree : d0.w contient le nombre total de longs mots #
! 205: # demandes si type I ou R #
! 206: # sortie : a0 pointe sur la zone allouee ; _avma est mis #
! 207: # a jour ; message d'erreur si memoire insuffisante ;#
! 208: # d0 est inchange;d1 et a1 sont sauvegardes. #
! 209: # remarque : il est interdit de creer des type S dans la pile #
! 210: # #
! 211: #===================================================================#
! 212:
! 213: | allocation memoire type qcque
! 214:
! 215: get: movl d1,sp@- | d0.l contient code et longueur
! 216: moveq #0,d1
! 217: movw d0,d1
! 218: lsll #2,d1
! 219: movl _avma,a0
! 220: subl d1,a0
! 221: cmpl _bot,a0
! 222: bmi mnet
! 223: movl a0,_avma
! 224: # swap d0
! 225: # movb #1,d0
! 226: # swap d0
! 227: movl d0,a0@
! 228: movl sp@+,d1
! 229: rts
! 230:
! 231: | allocation memoire de type I
! 232:
! 233: geti: movl d1,sp@-
! 234: moveq #0,d1
! 235: movw d0,d1
! 236: lsll #2,d1
! 237: movl _avma,a0
! 238: subl d1,a0
! 239: cmpl _bot,a0
! 240: bmi mnet
! 241: movl a0,_avma
! 242: movw #0x100,a0@
! 243: movw d0,a0@(2)
! 244: movl sp@+,d1
! 245: rts
! 246:
! 247: | allocation memoire type R
! 248:
! 249: getr: movl d1,sp@-
! 250: moveq #0,d1
! 251: movw d0,d1
! 252: lsll #2,d1
! 253: movl _avma,a0
! 254: subl d1,a0
! 255: cmpl _bot,a0
! 256: bmi mnet
! 257: movl a0,_avma
! 258: movw #0x200,a0@
! 259: movw d0,a0@(2)
! 260: movl sp@+,d1
! 261: rts
! 262:
! 263: | nettoyage pile PARI
! 264: | a ecrire .....!!!!!!!!!
! 265: mnet: movl #errpile,sp@-
! 266: jsr _pari_err
! 267:
! 268: #===================================================================#
! 269: # #
! 270: # Desallocation memoire PARI #
! 271: # #
! 272: # entree : a0@ contient le premier long mot code d'une #
! 273: # zone memoire a desallouer : uniquement de type #
! 274: # I ou R #
! 275: # sortie : _avma est mis a jour si necessaire #
! 276: # a0 pointe sur avma a jour #
! 277: # tous les autres registres sont inchanges #
! 278: # #
! 279: #===================================================================#
! 280:
! 281: giv: movl d0,sp@-
! 282: cmpl _avma,a0
! 283: bne givf
! 284: | ici la zone en tete de pile: on desalloue
! 285: movw a0@(2),d0
! 286: lea a0@(0,d0:w:4),a0| a0 pointe sur zone suivante
! 287: movl a0,_avma
! 288:
! 289: givf: movl sp@+,d0
! 290: rts
! 291:
! 292: #*******************************************************************#
! 293: #*******************************************************************#
! 294: #** **#
! 295: #** PROGRAMMES D'AFFECTATION OU D'ECHANGE **#
! 296: #** **#
! 297: #*******************************************************************#
! 298: #*******************************************************************#
! 299:
! 300:
! 301:
! 302:
! 303:
! 304: #===================================================================#
! 305: # #
! 306: # Affectation generale n2 --> n1 #
! 307: # #
! 308: # entree : a7@(4) pointe sur n2 de type I ou R #
! 309: # a7@(8) pointe sur n1 de type I ou R #
! 310: # sortie : la zone pointee par a7@(8) contient n2 #
! 311: # interdit : n2 ou n1 de type S #
! 312: # remarques: erreur dans le cas R --> I #
! 313: # d0,d1,a0,a1 sont inchanges #
! 314: # #
! 315: #===================================================================#
! 316:
! 317: _mpaff: cmpb #1,sp@(8)@
! 318: bne 1$
! 319: | ici T1 = I
! 320: cmpb #1,sp@(4)@
! 321: beq _affii | ici T1 = T2 = I
! 322: bra _affri | ici T1 = I et T2 = R
! 323: | ici T1 = R
! 324: 1$: cmpb #1,sp@(4)@
! 325: beq _affir | ici T1 = R et T2 = I
! 326: bra _affrr | ici T1 = T2 = R
! 327:
! 328: #-------------------------------------------------------------------#
! 329:
! 330: | affectation s2 --> i1 ou r1
! 331: _affsz: cmpb #2,sp@(4)@
! 332: beq _affsr
! 333: | affectation s2 --> i1
! 334:
! 335: _affsi: link a6,#0
! 336: moveml d0/a0,sp@-
! 337: movl a6@(8),d0 | d0.l contient s2
! 338: movl a6@(12),a0 | a0 pointe sur i1
! 339: cmpw #2,a0@(2)
! 340: bne 1$
! 341: | ici l1 = 2 (i1 = 0)
! 342: tstl d0
! 343: beq 4$
! 344: | ici s2 <> 0 (erreur)
! 345: movl #affer1,sp@-
! 346: jsr _pari_err
! 347: | ici s2 = 0 ou l1 >= 3
! 348: 1$: tstl d0
! 349: 4$: bmi 2$
! 350: | ici s2 >= 0
! 351: bne 3$
! 352: | ici s2 = 0
! 353: movl #2,a0@(4)
! 354: bra affsif
! 355: | ici s2 > 0 et l1 >= 3
! 356: 3$: movl #0x1000003,a0@(4)
! 357: movl d0,a0@(8)
! 358: bra affsif
! 359: | ici s2 < 0 et l1 >= 3
! 360: 2$: movl #0xff000003,a0@(4)
! 361: negl d0
! 362: movl d0,a0@(8)
! 363: affsif: moveml sp@+,d0/a0
! 364: unlk a6
! 365: rts
! 366:
! 367: #-------------------------------------------------------------------#
! 368:
! 369: | affectation i2 --> i1
! 370:
! 371: _affii: link a6,#0
! 372: moveml d0/a0-a1,sp@-
! 373: movl a6@(8),a1 | a1 pointe sur i2
! 374: movl a6@(12),a0 | a0 pointe sur i1
! 375: cmpl a0,a1
! 376: beq affiif
! 377: | ici a0 <> a1
! 378: movw a0@(2),d0 | d0.w contient l1
! 379: cmpw a1@(6),d0
! 380: bcc 1$
! 381: | ici le2 > l1 (erreur)
! 382: movl #affer3,sp@-
! 383: jsr _pari_err
! 384: | ici le2 <= l1
! 385: 1$: movw a1@(6),d0 | d0.w contient le2
! 386: subqw #2,d0 | d0.w contient L2
! 387: addql #4,a0
! 388: addql #4,a1
! 389: | copie de i2 dans i1
! 390: 2$: movl a1@+,a0@+
! 391: dbra d0,2$
! 392: affiif: moveml sp@+,d0/a0-a1
! 393: unlk a6
! 394: rts
! 395:
! 396: #-------------------------------------------------------------------#
! 397:
! 398: | conversion i --> long du C dans d0
! 399:
! 400: _itos: movl a1,sp@-
! 401: movl sp@(8),a1 | a1 pointe sur i2
! 402: cmpw #3,a1@(6)
! 403: bls 1$
! 404: | ici l2 >= 4 (erreur)
! 405: movl #affer2,sp@-
! 406: jsr _pari_err
! 407: | ici l2 <= 3
! 408: 1$: beq 2$
! 409: | ici l2 = 2 (i2 = 0)
! 410: moveq #0,d0
! 411: bra itosf
! 412: | ici l2 = 3
! 413: 2$: movl a1@(8),d0 | d0.l contient |i2|
! 414: cmpl #0x80000000,d0
! 415: bcs 3$
! 416: beq 4$
! 417: | ici |i2| > 2^31 (erreur)
! 418: 5$: movl #affer2,sp@-
! 419: jsr _pari_err
! 420: | ici |i2| = 2^31
! 421: 4$: tstb a1@(4)
! 422: bpl 5$ | si i2 = 2^31 erreur
! 423: bra itosf | ici i2 = -2^31
! 424: | ici |i2| <= 2^31-1
! 425: 3$: tstw a1@(4)
! 426: bpl itosf
! 427: negl d0
! 428: itosf: movl sp@+,a1
! 429: rts
! 430:
! 431: #-------------------------------------------------------------------#
! 432:
! 433: | conversion long du C --> i cree
! 434:
! 435: _stoi: movl sp@(4),d1
! 436: bne 1$
! 437: movl _gzero,d0
! 438: rts
! 439: 1$: movl #3,d0
! 440: bsr geti
! 441: tstl d1
! 442: bmi 2$
! 443: movl #0x1000003,a0@(4)
! 444: bra 3$
! 445: 2$: movl #0xff000003,a0@(4)
! 446: negl d1
! 447: 3$: movl d1,a0@(8)
! 448: movl a0,d0
! 449: rts
! 450:
! 451: #-----------------------------------------------------------------------#
! 452:
! 453: | affectation s2 --> r1
! 454:
! 455: _affsr: link a6,#0
! 456: moveml d0-d1/a0,sp@-
! 457: movl a6@(12),a0 | a0 pointe sur r1
! 458: movl a6@(8),d0 | d0.l contient s2
! 459: bne 1$
! 460: | ici s2 = 0
! 461: moveq #0,d0
! 462: movw a0@(2),d0
! 463: subqw #2,d0
! 464: lsll #5,d0
! 465: negl d0
! 466: addl #0x800000,d0 | d0.l contient fexp(0)
! 467: movl d0,a0@(4)
! 468: clrl a0@(8)
! 469: bra affsrf
! 470: | ici s2 <> 0
! 471: 1$: bpl 2$
! 472: negl d0
! 473: movb #0xff,a0@(4) | mise signe si s2 < 0
! 474: bra 3$
! 475: 2$: movb #1,a0@(4) | mise signe si s2 > 0
! 476: | ici s2 <> 0
! 477: 3$: bfffo d0{#0:#0},d1 | d1.l recoit nb. de shifts (=k)
! 478: lsll d1,d0 | d0.l est norme
! 479: negw d1
! 480: addw #31,d1
! 481: movw d1,a0@(6)
! 482: movb #0x80,a0@(5) | mise exposant
! 483: movl d0,a0@(8) | mise 1er long mot mantisse
! 484: moveq #0,d0
! 485: movw a0@(2),d1
! 486: subql #3,d1 | d1.w recoit L1-1
! 487: addl #12,a0 | a0 pointe sur 2eme long mot mantisse
! 488: bra 4$
! 489: 5$: movl d0,a0@+
! 490: 4$: dbra d1,5$
! 491: affsrf: moveml sp@+,d0-d1/a0
! 492: unlk a6
! 493: rts
! 494:
! 495: #-------------------------------------------------------------------#
! 496:
! 497: | affectation i2 --> r1
! 498:
! 499: _affir: link a6,#0
! 500: moveml d0-d6/a0-a1,sp@-
! 501: movl a6@(8),a1 | a1 pointe sur i2
! 502: movl a6@(12),a0 | a0 pointe sur r1
! 503: tstb a1@(4)
! 504: bne 1$
! 505: | ici i2 = 0
! 506: moveq #0,d0
! 507: movw a0@(2),d0
! 508: subqw #2,d0
! 509: lsll #5,d0
! 510: negl d0
! 511: addl #0x800000,d0
! 512: movl d0,a0@(4)
! 513: clrl a0@(8)
! 514: bra affirf
! 515: | ici i2 <> 0
! 516: 1$: movl a1@(8),d0 | d0.l contient 1er lg mot mantisse
! 517: bfffo d0{#0:#0},d1 | d1.l recoit nb de shifts (=k)
! 518: lsll d1,d0 | d0.l normalise
! 519: moveq #0,d2
! 520: movw a1@(6),d2
! 521: lsll #5,d2
! 522: subl d1,d2
! 523: addl #0x7fffbf,d2 | d2.l = fexp2 = 2^23 + L1*32 -1 -k
! 524: movl d2,a0@(4) | mise exposant
! 525: movb a1@(4),a0@(4) | mise signe
! 526: movw a1@(6),d4
! 527: subqw #3,d4 | d4.w recoit L2-1 (compteur)
! 528: movw a0@(2),d2
! 529: subqw #3,d2 | d2.w recoit L1-1
! 530: addl #12,a1 | a1 pointe sur 2eme lg mot mantisse i2
! 531: addql #8,a0 | a0 ponte sur 1er lg mot mantisse r1
! 532: moveq #1,d6 | masque
! 533: lsll d1,d6
! 534: subql #1,d6
! 535: subw d4,d2 | d2.w recoit L1-L2
! 536: bpl 2$
! 537: | ici L1 < L2
! 538: addw d2,d4 | d4.w recoit L1-1
! 539: bra 2$
! 540: | copie mantisse shiftee dans r1
! 541: 3$: movl a1@+,d3
! 542: roll d1,d3
! 543: movl d3,d5
! 544: andl d6,d3
! 545: addl d3,d0
! 546: movl d0,a0@+
! 547: subl d3,d5
! 548: movl d5,d0
! 549: 2$: dbra d4,3$
! 550: tstw d2
! 551: bmi 4$
! 552: | ici L1 > L2 completer par des 0
! 553: moveq #0,d3
! 554: movl d0,a0@+
! 555: bra 5$
! 556: 6$: movl d3,a0@+
! 557: 5$: dbra d2,6$
! 558: bra affirf
! 559: | ici L1 <= L2
! 560: 4$: movl a1@+,d3
! 561: roll d1,d3
! 562: andl d6,d3
! 563: addl d3,d0
! 564: movl d0,a0@+ | mise a jour dernier lg mot
! 565: affirf: moveml sp@+,d0-d6/a0-a1
! 566: unlk a6
! 567: rts
! 568:
! 569: #-------------------------------------------------------------------#
! 570:
! 571: | affectation r2 --> r1
! 572:
! 573: _affrr: link a6,#0
! 574: moveml d0-d1/a0-a1,sp@-
! 575: movl a6@(8),a1 | a1 pointe sur r2
! 576: movl a6@(12),a0 | a0 pointe sur r1
! 577: cmpl a0,a1
! 578: beq affrrf
! 579: | ici a0 <> a1
! 580: tstb a1@(4)
! 581: bne 6$
! 582: | ici r2 = 0
! 583: movl a1@(4),a0@(4)
! 584: clrl a0@(8)
! 585: bra affrrf
! 586: | ici r2 <> 0
! 587: 6$: addql #4,a0
! 588: addql #4,a1
! 589: movw a0@(-2),d0
! 590: movw a1@(-2),d1 | d0.w , d1.w contient l1,l2
! 591: cmpw d0,d1
! 592: bhi 1$
! 593: | ici l1 >= l2
! 594: subw d1,d0 | d0.w contient l1-l2
! 595: subqw #2,d1 | d1.w contient L2
! 596: 3$: movl a1@+,a0@+ | copie de r2 dans r1
! 597: dbra d1,3$
! 598: moveq #0,d1
! 599: bra 2$
! 600: | ici completer par des 0
! 601: 4$: movl d1,a0@+
! 602: 2$: dbra d0,4$
! 603: bra affrrf
! 604: | ici l2 > l1
! 605: 1$: subqw #2,d0 | d0.w recoit L1 (compteur)
! 606: 5$: movl a1@+,a0@+
! 607: dbra d0,5$
! 608: affrrf: moveml sp@+,d0-d1/a0-a1
! 609: unlk a6
! 610: rts
! 611:
! 612: #-------------------------------------------------------------------#
! 613:
! 614: | affectation r2 --> s1
! 615:
! 616: _affrs: movl #affer4,sp@-
! 617: jsr _pari_err
! 618:
! 619: #-------------------------------------------------------------------#
! 620:
! 621: | affectation r2 --> i1
! 622:
! 623: _affri: movl #affer5,sp@-
! 624: jsr _pari_err
! 625:
! 626:
! 627: #*******************************************************************#
! 628: #*******************************************************************#
! 629: #** **#
! 630: #** VALUATION **#
! 631: #** **#
! 632: #*******************************************************************#
! 633: #*******************************************************************#
! 634:
! 635:
! 636:
! 637:
! 638:
! 639: #===================================================================#
! 640: # #
! 641: # Valuation 2-adique d'un entier court ou d'un entier #
! 642: # #
! 643: # entree : a7@(4) contient s1 de type S ou pointe sur i1 de #
! 644: # type I #
! 645: # sortie : d0.l contient k tel que : k>=0 , n1=2^k*n2 , #
! 646: # avec n2 et 2 premiers entre eux ; si n1=0 , alors #
! 647: # d0.l contient -1. #
! 648: # remarque : type R interdit #
! 649: # #
! 650: #===================================================================#
! 651:
! 652: | valuation de s1 de type S
! 653:
! 654: _vals: link a6,#0
! 655: movl d2,sp@-
! 656: moveq #-1,d0
! 657: movl a6@(8),d1 | d1.l contient s1
! 658: beq valsf
! 659: moveq #0,d0
! 660: tstw d1
! 661: bne 1$
! 662: addl #16,d0
! 663: swap d1
! 664: 1$: tstb d1
! 665: bne 2$
! 666: addql #8,d0
! 667: lsrl #8,d1
! 668: 2$: movl d1,d2
! 669: andl #15,d2
! 670: bne 3$
! 671: addql #4,d0
! 672: lsrl #4,d1
! 673: 3$: movl d1,d2
! 674: andl #3,d2
! 675: bne 4$
! 676: addql #2,d0
! 677: lsrl #2,d1
! 678: 4$: btst #0,d1
! 679: bne valsf
! 680: addql #1,d0
! 681: valsf: movl sp@,d2
! 682: unlk a6
! 683: rts
! 684:
! 685: | valuation de i1 de type I
! 686:
! 687: _vali: link a6,#0
! 688: movl d2,sp@-
! 689: movl a6@(8),a1 | a1 pointe sur i1
! 690: moveq #-1,d0
! 691: tstb a1@(4)
! 692: beq valif
! 693: | ici i1 <> 0
! 694: movw a1@(6),d1 | d1.w contient L1+2
! 695: lea a1@(0,d1:w:4),a1| a1 pointe fin mantisse de i1
! 696: movl #0xffff,d0
! 697: 5$: tstl a1@-
! 698: dbne d0,5$
! 699: notw d0
! 700: lsll #5,d0 | d0.l contient 32*nb.de lgmots nuls
! 701: movl a1@,d1 | a droite de i1 et a1 pointe 1er lgmot
! 702: tstw d1 | non nul (qui existe car i1 <> 0)
! 703: bne 1$
! 704: addl #16,d0
! 705: swap d1
! 706: 1$: tstb d1
! 707: bne 2$
! 708: addql #8,d0
! 709: lsrl #8,d1
! 710: 2$: movl d1,d2
! 711: andl #15,d2
! 712: bne 3$
! 713: addql #4,d0
! 714: lsrl #4,d1
! 715: 3$: movl d1,d2
! 716: andl #3,d2
! 717: bne 4$
! 718: addql #2,d0
! 719: lsrl #2,d1
! 720: 4$: btst #0,d1
! 721: bne valif
! 722: addql #1,d0
! 723: valif: movl sp@,d2
! 724: unlk a6
! 725: rts
! 726:
! 727:
! 728:
! 729:
! 730:
! 731: #*******************************************************************#
! 732: #*******************************************************************#
! 733: #** **#
! 734: #** PROGRAMMES DE SHIFT **#
! 735: #** **#
! 736: #*******************************************************************#
! 737: #*******************************************************************#
! 738:
! 739:
! 740:
! 741:
! 742:
! 743: #===================================================================#
! 744: # #
! 745: # Shift general #
! 746: # #
! 747: # entree : a7@(4) pointe sur n2 de type I ou R #
! 748: # a7@(8) contient k = nombre de shifts #
! 749: # sortie : d0 pointe sur n1 de type I ou R #
! 750: # contenant n1 = 2^k * n2 (zone creee) #
! 751: # interdit : type S #
! 752: # #
! 753: #===================================================================#
! 754:
! 755: _mpshift:cmpb #1,sp@(4)@
! 756: beq _shifti
! 757: bra _shiftr
! 758:
! 759: #===================================================================#
! 760: # #
! 761: # Shift (par valeur) #
! 762: # #
! 763: # entree : a7@(4) pointe sur n2 de type I ou R #
! 764: # a7@(8) contient le nombre de shifts (=k) #
! 765: # a7@(12) pointe sur n1 de type I ou R #
! 766: # sortie : la zone pointee par a7@(12) contient 2^k * n2 #
! 767: # interdit : type S #
! 768: # #
! 769: #===================================================================#
! 770:
! 771: _mpshiftz:movl sp@(4),a0
! 772: cmpl sp@(12),a0
! 773: bne 1$
! 774: cmpb #2,a0@
! 775: bne 1$
! 776: movl a0@(4),d0
! 777: andl #0xffffff,d0
! 778: addl sp@(8),d0
! 779: bvs shier
! 780: cmpl #0x1000000,d0
! 781: bcc shier
! 782: tstl d0
! 783: bmi shier
! 784: movw d0,a0@(6)
! 785: swap d0
! 786: movb d0,a0@(5)
! 787: rts
! 788: 1$: movl sp@(8),sp@-
! 789: movl sp@(8),sp@-
! 790: bsr _mpshift
! 791: movl d0,sp@
! 792: movl sp@(20),sp@(4)
! 793: bsr _mpaff
! 794: movl sp@,a0
! 795: addql #8,sp
! 796: bra giv
! 797:
! 798: #===================================================================#
! 799: # #
! 800: # Shift d'un entier court = entier #
! 801: # #
! 802: # entree : a7@(4) contient s2 de type S #
! 803: # a7@(8) contient k = nombre de shifts #
! 804: # sortie : d0 pointe sur i1 de type I #
! 805: # avec i1 = 2^k * s2 (zone creee) #
! 806: # #
! 807: #===================================================================#
! 808:
! 809: _shifts:link a6,#-12
! 810: movl a6@(12),sp@- | empilage k
! 811: movl a6@(8),d0 | d0.l contient s2
! 812: bne 1$
! 813: | ici s2 = 0
! 814: movl #0x1000002,a6@(-12)
! 815: movl #2,a6@(-8) | creation de 0 en var. locale
! 816: bra 3$
! 817: | ici s2 <> 0
! 818: 1$: movl #0x1000003,a6@(-12)
! 819: movl #0x1000003,a6@(-8)
! 820: tstl d0
! 821: bpl 2$
! 822: negl d0
! 823: movb #0xff,a6@(-8)
! 824: 2$: movl d0,a6@(-4) | creation de s2 en var. locale
! 825: 3$: pea a6@(-12) | empilage adresse var. locale
! 826: bsr _shifti
! 827: unlk a6
! 828: rts
! 829:
! 830: #===================================================================#
! 831: # #
! 832: # Shift entier = entier #
! 833: # #
! 834: # entree : a7@(4) pointe sur i2 de type I #
! 835: # a7@(8) contient k = nombre de shifts #
! 836: # sortie : d0 pointe sur i1 de type I #
! 837: # avec i1 = 2^k * i2 (zone creee) #
! 838: # #
! 839: #===================================================================#
! 840:
! 841: _shifti:link a6,#0
! 842: moveml d2-d7/a2-a3,sp@-
! 843: movl a6@(8),a2 | a2 pointe sur i2
! 844: movl a6@(12),d7 | d7.l contient k
! 845: bne 1$
! 846: | ici k = 0
! 847: movw a2@(2),d0
! 848: bsr geti
! 849: movl a0,a3 | sauvegarde adresse resultat
! 850: subqw #2,d0
! 851: addql #4,a0
! 852: addql #4,a2
! 853: 24$: movl a2@+,a0@+
! 854: dbra d0,24$
! 855: bra shiftif
! 856: | ici k <> 0
! 857: 1$: tstb a2@(4)
! 858: bne 2$
! 859: | ici i1 = 0
! 860: 6$: movl _gzero,d0 | sauvegarde adresse resultat
! 861: bra shiftig
! 862: | ici k <> 0 et i2 <> 0
! 863: 2$: moveq #0,d0
! 864: movw a2@(6),d0 | d0.w contient L2+2
! 865: cmpl #1,d7
! 866: bne 3$
! 867: | ici k = 1 et i2 <> 0
! 868: movl a2@(8),d5
! 869: btst #31,d5
! 870: beq 4$
! 871: | ici d5 >= 2^31
! 872: addqw #1,d0 | demander 1 lgmot supplementaire
! 873: cmpw #0x8000,d0
! 874: bcs 4$
! 875: | ici debordement
! 876: 18$: movl #shier1,sp@-
! 877: jsr _pari_err
! 878: | ici k = 1 et i2 <> 0
! 879: 4$: bsr geti
! 880: movl a0,a3 | sauvegarde adresse resultat
! 881: movw a0@(2),a0@(6) | mise longueur effective
! 882: movb a2@(4),a0@(4) | mise signe
! 883: lea a0@(0,d0:w:4),a1| a1 pointe fin resultat
! 884: lea a2@(0,d0:w:4),a2
! 885: btst #31,d5
! 886: beq 5$
! 887: subqw #4,a2 | ici a2 pointe fin i2
! 888: movl #1,a0@(8)
! 889: subqw #1,d0
! 890: 5$: subqw #3,d0 | d0.w compteur
! 891: 7$: movl a2@-,d1
! 892: roxll #1,d1
! 893: movl d1,a1@-
! 894: dbra d0,7$
! 895: bra shiftif
! 896: | ici k <> 1 et i2 <> 0
! 897: 3$: cmpl #-1,d7
! 898: bne 8$
! 899: | ici k = -1 et i2 <> 0
! 900: cmpl #1,a2@(8)
! 901: bhi 9$
! 902: subqw #1,d0
! 903: cmpw #2,d0
! 904: beq 6$ | si i1 = 0
! 905: 9$: bsr geti
! 906: movl a0,a3
! 907: movb a2@(4),a0@(4) | mise signe
! 908: movw a0@(2),a0@(6) | mise longueur effective
! 909: addql #8,a0
! 910: addql #8,a2
! 911: movw a2@(-2),d0
! 912: subqw #3,d0 | d0.w compteur
! 913: movl a2@+,d1
! 914: lsrl #1,d1
! 915: beq 10$
! 916: movl d1,a0@+
! 917: bra 10$
! 918: 11$: movl a2@+,d1
! 919: roxrl #1,d1
! 920: movl d1,a0@+
! 921: 10$: dbra d0,11$
! 922: bra shiftif
! 923: | ici k<>0,k<>1,k<>-1 et i2<>0
! 924: 8$: tstl d7
! 925: bpl 12$
! 926: | ici shift a droite : k < -1 et i2 <> 0
! 927: negl d7 | d7.l contient /k/
! 928: movl d7,d4
! 929: lsrl #5,d4 | d4.l contient q
! 930: andl #31,d7 | k=32*q+r; d7.l contient r
! 931:
! 932: subw #2,d0 | d0.w contient L2
! 933: cmpw d4,d0
! 934: bls 6$ | si r1 <= 0
! 935: addw #2,d0 |
! 936: subw d4,d0 | d0.w contient L2+2-q
! 937:
! 938: movl a2@(8),d4
! 939: lsrl d7,d4
! 940: bne 13$
! 941: | ici on perd un lgmot de resultat
! 942: subqw #1,d0
! 943: cmpw #2,d0
! 944: beq 6$ | si r1 = 0
! 945: 13$: bsr geti | allocation memoire pour resultat
! 946: movl a0,a3
! 947: movb a2@(4),a0@(4) | mise signe
! 948: movw a0@(2),a0@(6) | mise longueur effective
! 949: lea a2@(0,d0:w:4),a2| a2 pointe ou il faut !
! 950: lea a0@(0,d0:w:4),a1| a1 pointe fin resultat
! 951: tstl d4
! 952: beq 14$
! 953: movl d4,a0@(8)
! 954: subqw #3,d0 | d0.w compteur
! 955: bra 15$
! 956: 14$: addql #4,a2
! 957: subqw #2,d0
! 958: 15$: moveq #-1,d6
! 959: lsrl d7,d6 | masque de shift
! 960: movl a2@-,d4
! 961: lsrl d7,d4
! 962: bra 16$
! 963: 17$: movl a2@-,d2 | boucle de shift
! 964: rorl d7,d2
! 965: movl d2,d3
! 966: andl d6,d3
! 967: subl d3,d2
! 968: addl d2,d4
! 969: movl d4,a1@-
! 970: movl d3,d4
! 971: 16$: dbra d0,17$
! 972: bra shiftif
! 973: | ici shift a gauche : k > 1 et i2 <> 0
! 974: 12$: movl d7,d4
! 975: andl #31,d7 | d7.l contient r
! 976: lsrl #5,d4 | d4.l contient q (k=32*q+r)
! 977: addl d4,d0 | d0.l contient L2+2+q
! 978: cmpw #0x7fff,d0
! 979: bcc 18$
! 980: moveq #-1,d6
! 981: lsll d7,d6
! 982: notl d6 | masque de shift
! 983: movl a2@(8),d2
! 984: roll d7,d2
! 985: movl d2,d3
! 986: andl d6,d3
! 987: beq 19$
! 988: addqw #1,d0 | un long mot supplementaire
! 989: 19$: bsr geti
! 990: movl a0,a3
! 991: movl a0@(2),a0@(6) | mise longueur effective
! 992: movb a2@(4),a0@(4) | mise signe
! 993: addql #8,a0
! 994: tstl d3
! 995: beq 20$
! 996: movl d3,a0@+
! 997: 20$: subl d3,d2
! 998: movl d2,d5
! 999: movw a2@(6),d0
! 1000: addl #12,a2
! 1001: subqw #3,d0 | d0.w contient compteur
! 1002: bra 21$
! 1003: 22$: movl a2@+,d2
! 1004: roll d7,d2
! 1005: movl d2,d3
! 1006: andl d6,d3
! 1007: subl d3,d2
! 1008: addl d3,d5
! 1009: movl d5,a0@+
! 1010: movl d2,d5
! 1011: 21$: dbra d0,22$
! 1012: movl d5,a0@+
! 1013: moveq #0,d0
! 1014: bra 23$
! 1015: 25$: movl d0,a0@+
! 1016: 23$: dbra d4,25$
! 1017: shiftif:movl a3,d0 | d0 pointe sur resultat
! 1018: shiftig:moveml sp@+,d2-d7/a2-a3
! 1019: unlk a6
! 1020: rts
! 1021:
! 1022: #===================================================================#
! 1023: # #
! 1024: # Shift reel = reel #
! 1025: # #
! 1026: # entree : a7@(4) pointe sur r2 de type R #
! 1027: # a7@(8) contient k = nombre de shifts #
! 1028: # sortie : d0 pointe sur r1 de type R #
! 1029: # avec r1 = 2^k * r2 zone creee) #
! 1030: # #
! 1031: #===================================================================#
! 1032:
! 1033: _shiftr:link a6,#0
! 1034: moveml d2/a2-a3,sp@-
! 1035: movl a6@(8),a2 | a2 pointe sur r2
! 1036: movl a6@(12),d2 | d2.l contient k
! 1037: bne 1$
! 1038: | ici k = 0
! 1039: movw a2@(2),d0
! 1040: bsr getr
! 1041: movl a0,a3
! 1042: subqw #2,d0
! 1043: addql #4,a0
! 1044: addql #4,a2
! 1045: 4$: movl a2@+,a0@+
! 1046: dbra d0,4$ | boucle de recopie de r2 dans r1
! 1047: bra shiftrf
! 1048: | ici k <> 0
! 1049: 1$: movl a2@(4),d1
! 1050: andl #0xffffff,d1
! 1051: addl d2,d1 | d1.l contient fexp2 + k
! 1052: bvc sh
! 1053: | ici debordement
! 1054: shier: movl #shier2,sp@-
! 1055: jsr _pari_err
! 1056: | ici k + fexp2 <= 2^31 -1
! 1057: sh: cmpl #0x1000000,d1
! 1058: bcc shier | si k + fexp2 >= 2^24
! 1059: tstl d1
! 1060: bmi shier | si k + fexp2 < 0
! 1061: movw a2@(2),d0
! 1062: bsr getr | allocation memoire pour resultat
! 1063: movl a0,a3
! 1064: movl d1,a0@(4) | mise exposant
! 1065: movb a2@(4),a0@(4) | mise signe
! 1066: addql #8,a0
! 1067: addql #8,a2
! 1068: subqw #3,d0
! 1069: 5$: movl a2@+,a0@+
! 1070: dbra d0,5$
! 1071: shiftrf:movl a3,d0 | d0 pointe sur resultat
! 1072: moveml sp@+,d2/a2-a3
! 1073: unlk a6
! 1074: rts
! 1075:
! 1076:
! 1077:
! 1078:
! 1079:
! 1080: #*******************************************************************#
! 1081: #*******************************************************************#
! 1082: #** **#
! 1083: #** PROGRAMMES DE PARTIE ENTIERE **#
! 1084: #** **#
! 1085: #*******************************************************************#
! 1086: #*******************************************************************#
! 1087:
! 1088:
! 1089:
! 1090:
! 1091:
! 1092: #===================================================================#
! 1093: # #
! 1094: # Fausse partie entiere (trunc) #
! 1095: # #
! 1096: # entree : a7@(4) pointe sur n1 de type I ou de type R #
! 1097: # sortie : d0 pointe sur i1 de type I (zone creee) #
! 1098: # calcul : si r1 >= 0 , i1 est la partie entiere #
! 1099: # si r1 < 0 , i1 = - Ent (-r1) #
! 1100: # remarque : type S interdit #
! 1101: # #
! 1102: #===================================================================#
! 1103:
! 1104: _mptrunc:link a6,#0
! 1105: moveml d2-d6/a2-a4,sp@-
! 1106: movl a6@(8),a1 | a1 pointe sur n1
! 1107: cmpb #1,a1@
! 1108: bne 5$
! 1109: | ici n1 est de type I
! 1110: movw a1@(6),d0
! 1111: bsr geti
! 1112: movl a0,a4
! 1113: subqw #2,d0
! 1114: addql #4,a0
! 1115: addql #4,a1
! 1116: 7$: movl a1@+,a0@+
! 1117: dbra d0,7$
! 1118: bra truncf
! 1119: | ici n1 est de type R
! 1120: 5$: movl a1@(4),d3 | d3.l contient second long mot code r1
! 1121: movl d3,d0
! 1122: andl #0xffffff,d0 | d0.l contient fexp1
! 1123: subl #0x800000,d0 | d0.l contient exp1
! 1124: bpl 1$
! 1125: | ici exp1 < 0 (trunc r1 = 0)
! 1126: movl _gzero,d0
! 1127: bra truncg
! 1128: | ici exp1 >= 0
! 1129: 1$: movl d0,d2 | d2.l contient exp1
! 1130: lsrl #5,d0 | d0.l contient exp1 div 32 = q
! 1131: addql #3,d0 | d0.l contient le(i1)
! 1132: cmpl #0x7fff,d0
! 1133: bls 2$
! 1134: | ici le(i1)> 2^15 : erreur
! 1135: movl #truer1,sp@-
! 1136: jsr _pari_err
! 1137: | ici le(i1)<=2^15
! 1138: 2$: bsr geti | allocation q+3 longs mots pour i1
! 1139: movl a0,a4
! 1140: movw d0,a0@(6) | mise longueur effective de i1
! 1141: movb a1@(4),a0@(4) | mise signe de i1
! 1142: movl a0,a3 | sauvegarde adresse i1
! 1143: addql #8,a0
! 1144: addql #8,a1 | a0,a1 pointent sur mantisses i1,r1
! 1145: movw a1@(-6),d1 | d1.w contient l(r1)
! 1146: subw d0,d1 | d1.w contient l(r1)-le(i1)
! 1147: bpl 3$
! 1148: | ici l(r1)<le(i1) : erreur
! 1149: movl #truer2,sp@-
! 1150: jsr _pari_err
! 1151: | ici l(r1)>=le(i1)
! 1152: 3$: subqw #3,d0 | d0.w contient l(i1)-1 (compteur)
! 1153: addqb #1,d2 | d2.b contient exp1+1 (derniers bits)
! 1154: andb #31,d2 | d2.b contient exp1+1 mod 32
! 1155: bne 4$
! 1156: | ici pas de shift a faire
! 1157: 8$: movl a1@+,a0@+
! 1158: dbra d0,8$ | recopie des mantisses
! 1159: bra truncf
! 1160: | ici d2.b shifts a faire
! 1161: 4$: moveq #1,d6
! 1162: lsll d2,d6
! 1163: subql #1,d6 | masque de shift
! 1164: moveq #0,d5
! 1165: 6$: movl a1@+,d3 | boucle de shift
! 1166: roll d2,d3
! 1167: movl d3,d4
! 1168: andl d6,d4
! 1169: subl d4,d3
! 1170: addl d5,d4
! 1171: movl d4,a0@+
! 1172: movl d3,d5
! 1173: dbra d0,6$
! 1174: truncf: movl a4,d0 | d0 pointe sur resultat
! 1175: truncg: moveml sp@+,d2-d6/a2-a4
! 1176: unlk a6
! 1177: rts
! 1178:
! 1179: #===================================================================#
! 1180: # #
! 1181: # Fausse partie entiere (par valeur) #
! 1182: # #
! 1183: # entree : a7@(4) pointe sur n2 de type I ou R #
! 1184: # a7@(8) pointe sur n1 de type I ou R #
! 1185: # sortie : la zone pointee par a7@(8) contient trunc(n2) #
! 1186: # interdit : type S #
! 1187: # #
! 1188: #===================================================================#
! 1189:
! 1190: _mptruncz:movl sp@(4),sp@-
! 1191: bsr _mptrunc
! 1192: movl sp@(12),sp@
! 1193: movl d0,sp@-
! 1194: bsr _mpaff
! 1195: movl d0,a0
! 1196: addql #8,sp
! 1197: bra giv
! 1198:
! 1199: #===================================================================#
! 1200: # #
! 1201: # Partie entiere ( max { n <= x} ) #
! 1202: # #
! 1203: # entree : a7@(4) pointe sur n1 de type I ou R #
! 1204: # sortie : d0 pointe sur i1 de type I (zone creee) #
! 1205: # remarque : type S interdit #
! 1206: # #
! 1207: #===================================================================#
! 1208:
! 1209: _mpent: link a6,#0
! 1210: moveml d2-d6/a2-a4,sp@-
! 1211: movl a6@(8),a1 | a1 pointe sur n1
! 1212: cmpb #1,a1@
! 1213: bne 1$
! 1214: | ici n1 est de type I
! 1215: movw a1@(6),d0 | d0.w recoit le1
! 1216: bsr geti
! 1217: movl a0,a4 | sauvegarde adresse resultat
! 1218: subqw #2,d0
! 1219: addql #4,a0
! 1220: addql #4,a1
! 1221: 6$: movl a1@+,a0@+
! 1222: dbra d0,6$
! 1223: bra entf
! 1224: | ici n1 est de type R
! 1225: 1$: tstb a1@(4)
! 1226: blt 2$
! 1227: | ici n1 >= 0 (ent(n1)=trunc(n1))
! 1228: movl a6@(8),sp@- | empilage adresse n1
! 1229: bsr _mptrunc
! 1230: movl d0,a4 | sauvegarde adresse resultat
! 1231: addql #4,sp
! 1232: bra entf
! 1233: | ici n1 < 0
! 1234: 2$: movl a1@(4),d3
! 1235: andl #0xffffff,d3
! 1236: subl #0x800000,d3 | d3.l contient exp1
! 1237: bpl 3$
! 1238: | ici exp1 < 0 (ent(n1)=-1)
! 1239: moveq #3,d0
! 1240: bsr geti
! 1241: movl a0,a4 | sauvegarde adresse resultat
! 1242: movl #0xff000003,a0@(4)
! 1243: movl #1,a0@(8)
! 1244: bra entf
! 1245: | ici exp1 >= 0
! 1246: 3$: movl _avma,a3 | ancien _avma dans var. locale
! 1247: movl a6@(8),sp@- | empilage adresse n1
! 1248: bsr _mptrunc
! 1249: movl d0,a4 | sauvegarde adresse res. provisoire
! 1250: addql #4,sp | depilage des parametres
! 1251: movl d3,d1 | d1.l contient exp1
! 1252: lsrl #5,d3 | d3.l contient exp1 div 32 = q
! 1253: andl #31,d1 | d1.l contient exp1 mod 32 = r
! 1254: movl a6@(8),a1
! 1255: lea a1@(8,d3:l:4),a2| a2 pointe q+1eme lgmot mantisse
! 1256: movl #0x80000000,d6 | d6.l contient 2^31
! 1257: lsrl d1,d6 | d6.l contient 2^(31-r)
! 1258: subql #1,d6 | masque:0...01...1 avec r+1 zeros
! 1259: moveq #0,d2
! 1260: movw a1@(2),d2
! 1261: subql #3,d2 | d2.l contient L1-1
! 1262: subl d3,d2 | d2.l contient L1-1-q
! 1263: movl a2@+,d5 | d5.l contient le q+1 eme lgmot
! 1264: andl d6,d5
! 1265: beq 4$
! 1266: bra 5$
! 1267: 7$: tstl a2@+
! 1268: 4$: dbne d2,7$
! 1269: bne 5$
! 1270: | ici tous les lgmots sont nuls
! 1271: bra entf
! 1272: | ici un au moins non nul
! 1273: 5$: movl a4,sp@- | empilage trunc(n1)
! 1274: movl #0xffffffff,sp@-| empilage -1
! 1275: bsr _addsi | calcul de trunc(n1)-1
! 1276: addql #8,sp | depilage
! 1277: movl a4,a1 | a1 pointe sur trunc(n1)
! 1278: movl a3,a4 | a4 contient _avma ancien
! 1279: movl d0,a0 | a0 pointe sur resultat (res)
! 1280: movw a0@(2),d0 | d0.w contient l(res)
! 1281: subqw #1,d0 | d0.w contient l-1
! 1282: 8$: movl a1@-,a4@-
! 1283: dbra d0,8$ | transfert du resultat ds pile PARI
! 1284: movl a4,_avma | mise a jour pile PARI
! 1285: entf: movl a4,d0 | d0 pointe sur resultat
! 1286: moveml sp@+,d2-d6/a2-a4
! 1287: unlk a6
! 1288: rts
! 1289:
! 1290: #===================================================================#
! 1291: # #
! 1292: # Partie entiere (par valeur) #
! 1293: # #
! 1294: # entree : a7@(4) pointe sur n2 de type I ou R #
! 1295: # a7@(8) pointe sur n1 de type I ou R #
! 1296: # sortie : la zone pointee par a7@(8) contient ent(n2) #
! 1297: # interdit : type S #
! 1298: # #
! 1299: #===================================================================#
! 1300:
! 1301: _mpentz:movl sp@(4),sp@-
! 1302: bsr _mpent
! 1303: movl sp@(12),sp@
! 1304: movl d0,sp@-
! 1305: bsr _mpaff
! 1306: movl d0,a0
! 1307: addql #8,sp
! 1308: bra giv
! 1309:
! 1310:
! 1311:
! 1312:
! 1313:
! 1314: #*******************************************************************#
! 1315: #*******************************************************************#
! 1316: #** **#
! 1317: #** PROGRAMMES DE COMPARAISON **#
! 1318: #** **#
! 1319: #*******************************************************************#
! 1320: #*******************************************************************#
! 1321:
! 1322:
! 1323:
! 1324:
! 1325:
! 1326: #===================================================================#
! 1327: # #
! 1328: # Comparaison generale #
! 1329: # #
! 1330: # entree : a7@(4) pointe sur n2 de type I ou R #
! 1331: # a7@(8) pointe sur n1 de type I ou R #
! 1332: # sortie : d0.l contient -1 si n2<n1,0 si n2=n1,1 sinon. #
! 1333: # d1,a0,a1 sont sauvegardes #
! 1334: # interdit : type S #
! 1335: # #
! 1336: #===================================================================#
! 1337:
! 1338: _mpcmp: link a6,#0
! 1339: moveml d1-d2/a1-a2,sp@-
! 1340: movl a6@(8),a2
! 1341: movl a6@(12),a1 | a1 et a2 pointent sur n1 et n2
! 1342: moveq #0,d1
! 1343: movb a2@,d2 | d2.b contient T2
! 1344: cmpb a1@,d2
! 1345: ble 1$
! 1346: | ici T2 > T1
! 1347: exg a1,a2
! 1348: moveq #1,d1
! 1349: | ici T2 <= T1
! 1350: 1$: movl a1,sp@-
! 1351: movl a2,sp@-
! 1352: cmpb #1,a1@
! 1353: bne 2$
! 1354: | ici T1 = T2 = I
! 1355: bsr _cmpii
! 1356: bra cmpf
! 1357: | ici T1 = R
! 1358: 2$: cmpb #1,a2@
! 1359: bne 3$
! 1360: | ici T1 = R et T2 = I
! 1361: bsr _cmpir
! 1362: bra cmpf
! 1363: | ici T1 = T2 = R
! 1364: 3$: bsr _cmprr
! 1365: cmpf: addql #8,sp
! 1366: tstb d1
! 1367: beq 1$
! 1368: negl d0
! 1369: 1$: moveml sp@+,d1-d2/a1-a2
! 1370: unlk a6
! 1371: rts
! 1372:
! 1373: #===================================================================#
! 1374: # #
! 1375: # Comparaison : entier court et entier #
! 1376: # #
! 1377: # entree : a7@(4) contient s2 de type S #
! 1378: # a7@(8) pointe sur i1 de type I #
! 1379: # sortie : d0.l contient 1 si s2>i1,0 si s2=i1,-1 sinon #
! 1380: # d1,a0,a1 sont sauvegardes #
! 1381: # #
! 1382: #===================================================================#
! 1383:
! 1384: _cmpsi: link a6,#0
! 1385: moveml d1-d4/a1,sp@-
! 1386: movl a6@(12),a1 | a1 pointe sur i1
! 1387: movb a1@(4),d1 | d1.b contient signe de i1 (si1)
! 1388: movb d1,d4 | d4.b contient si1
! 1389: movb #1,d3
! 1390: movl a6@(8),d2 | d2.l contient s2
! 1391: bgt 1$ | si s2 > 0
! 1392: | ici s2 <= 0
! 1393: bne 2$ | si s2 < 0
! 1394: | ici s2 = 0
! 1395: movb #0,d3
! 1396: bra 1$
! 1397: | ici s2 < 0
! 1398: 2$: movb #-1,d3 | d3.b contient signe de s2 (ss2)
! 1399: 1$: eorb d3,d4 | d4.b contient :
! 1400: | 0 si les deux nuls ou >0 ou <0
! 1401: | >0 si un nul l'autre >0
! 1402: | <0 si un nul autre<0,un<0 autre>0
! 1403: bpl 3$
! 1404: | ici d4.b < 0
! 1405: moveq #1,d0
! 1406: tstb d3
! 1407: bpl 4$
! 1408: | ici s2<0 et i1>0
! 1409: moveq #-1,d0
! 1410: 4$: bra cmpsif
! 1411: | ici d4.b >=0
! 1412: 3$: cmpw #3,a1@(6)
! 1413: ble 5$
! 1414: | ici L1 >= 2
! 1415: 8$: moveq #-1,d0
! 1416: tstb d1
! 1417: bpl 6$
! 1418: negl d0
! 1419: 6$: bra cmpsif
! 1420: | ici L1 <= 1
! 1421: 5$: cmpw #2,a1@(6)
! 1422: beq 7$
! 1423: | ici L1 = 1
! 1424: tstl d2
! 1425: bpl 9$
! 1426: negl d2
! 1427: 9$: moveq #1,d0
! 1428: cmpl a1@(8),d2
! 1429: bhi 10$
! 1430: bne 11$
! 1431: moveq #0,d0
! 1432: bra cmpsif
! 1433: 11$: moveq #-1,d0
! 1434: 10$: tstb d1
! 1435: bpl cmpsif
! 1436: negl d0
! 1437: bra cmpsif
! 1438: 7$: moveq #1,d0
! 1439: tstb d3
! 1440: bne cmpsif
! 1441: moveq #0,d0
! 1442: cmpsif: moveml sp@+,d1-d4/a1
! 1443: unlk a6
! 1444: rts
! 1445:
! 1446: #===================================================================#
! 1447: # #
! 1448: # Comparaison : entier court et reel #
! 1449: # #
! 1450: # entree : a7@(4) contient s2 de type S #
! 1451: # a7@(8) pointe sur r1 de type R #
! 1452: # sortie : d0.l contient 1 si s2>r1, 0 si s2=r1, -1 sinon #
! 1453: # d1,a0,a1 sont sauvegardes #
! 1454: # #
! 1455: #===================================================================#
! 1456:
! 1457: _cmpsr: link a6,#0
! 1458: moveml d1-d4/a0-a2,sp@-
! 1459: movl a6@(12),a1 | a1 pointe sur r1
! 1460: movb a1@(4),d1 | d1.b contient sr1 (signe de r1)
! 1461: movb d1,d4 | d4.b aussi
! 1462: movb #1,d3
! 1463: movl a6@(8),d2 | d2.l contient s2
! 1464: bgt 1$
! 1465: bne 2$
! 1466: movb #0,d3
! 1467: bra 1$
! 1468: 2$: movb #-1,d3 | d3.b contient ss2 (signe de s2)
! 1469: 1$: eorb d3,d4 | d4.b contient 'signe'
! 1470: bpl 3$
! 1471: | ici d4.b < 0
! 1472: moveq #1,d0
! 1473: tstb d3
! 1474: bpl 4$
! 1475: moveq #-1,d0
! 1476: 4$: bra cmpsrf
! 1477: | ici d4.b >= 0
! 1478: 3$: tstb d1
! 1479: bne 5$
! 1480: | ici r1 = 0
! 1481: moveq #1,d0
! 1482: tstb d3
! 1483: bne 6$
! 1484: | ici s2 = r1 = 0
! 1485: moveq #0,d0
! 1486: 6$: bra cmpsrf
! 1487: | ici r1 <> 0
! 1488: 5$: movw a1@(2),d0
! 1489: bsr getr | pour copie reelle de s2
! 1490: movl a0,a2 | sauvegarde adresse copie
! 1491: movl a0,sp@- | empilage adresse copie
! 1492: movl d2,sp@- | empilage s2
! 1493: bsr _affsr
! 1494: addql #8,sp | depilage
! 1495: movl a1,sp@- | empilage adresse r1
! 1496: movl a0,sp@- | empilage adresse copie
! 1497: bsr _cmprr
! 1498: addql #8,sp
! 1499: movl a2,a0
! 1500: bsr giv
! 1501: cmpsrf: moveml sp@+,d1-d4/a0-a2
! 1502: unlk a6
! 1503: rts
! 1504:
! 1505: #===================================================================#
! 1506: # #
! 1507: # Comparaison : entier et entier court #
! 1508: # #
! 1509: # entree : a7@(4) pointe sur i2 de type I #
! 1510: # a7@(8) contient s1 #
! 1511: # sortie : d0.l contient le signe de i2 - s1 #
! 1512: # aucun autre registre n'est affecte #
! 1513: # #
! 1514: #===================================================================#
! 1515:
! 1516: _cmpis: movl sp@(4),sp@-
! 1517: movl sp@(12),sp@-
! 1518: bsr _cmpsi
! 1519: addql #8,sp
! 1520: negl d0
! 1521: rts
! 1522:
! 1523: #===================================================================#
! 1524: # #
! 1525: # Comparaison : entier et entier #
! 1526: # #
! 1527: # entree : a7@(4) pointe sur i2 de type I #
! 1528: # a7@(8) pointe sur i1 de type I #
! 1529: # sortie : d0.l contient :1 si i2>i1,0 si i2=i1,-1 sinon #
! 1530: # d1,a0,a1 sont sauvegardes #
! 1531: # #
! 1532: #===================================================================#
! 1533:
! 1534: _cmpii: link a6,#0
! 1535: moveml d1-d4/a1-a2,sp@-
! 1536: movl a6@(8),a2
! 1537: movl a6@(12),a1 | a1, a2 pointent sur i1, i2
! 1538: movb a1@(4),d1 | d1.b contient si1
! 1539: movb d1,d4
! 1540: movb a2@(4),d2 | d2.b contient si2
! 1541: eorb d2,d4
! 1542: bpl 1$
! 1543: | ici d4.b < 0
! 1544: moveq #1,d0
! 1545: tstb d2
! 1546: bpl cmpiif
! 1547: moveq #-1,d0
! 1548: bra cmpiif
! 1549: | ici d4.b >= 0
! 1550: 1$: movw a1@(6),d1
! 1551: movw a2@(6),d2 | d1.w et d2.w contiennent le1 et le2
! 1552: cmpw d1,d2
! 1553: blt 3$
! 1554: beq 4$
! 1555: | ici le2 > le1
! 1556: 6$: moveq #1,d0
! 1557: tstb a1@(4)
! 1558: bpl cmpiif
! 1559: moveq #-1,d0
! 1560: bra cmpiif
! 1561: | ici le2 < le1
! 1562: 3$: moveq #-1,d0
! 1563: tstb a2@(4)
! 1564: bpl cmpiif
! 1565: moveq #1,d0
! 1566: bra cmpiif
! 1567: | ici le2 = le1
! 1568: 4$: cmpw #2,d1
! 1569: bne 7$
! 1570: moveq #0,d0
! 1571: bra cmpiif
! 1572: | ici i1 et i2 <> 0
! 1573: 7$: movb a1@(4),d3
! 1574: addql #8,a1
! 1575: addql #8,a2
! 1576: subqw #3,d1
! 1577: 11$: cmpml a1@+,a2@+
! 1578: dbne d1,11$
! 1579: bhi 8$
! 1580: beq 9$
! 1581: moveq #-1,d0
! 1582: bra 10$
! 1583: 9$: moveq #0,d0
! 1584: bra cmpiif
! 1585: 8$: moveq #1,d0
! 1586: 10$: tstb d3
! 1587: bpl cmpiif
! 1588: negl d0
! 1589: cmpiif: moveml sp@+,d1-d4/a1-a2
! 1590: unlk a6
! 1591: rts
! 1592:
! 1593: #===================================================================#
! 1594: # #
! 1595: # Comparaison : entier et reel #
! 1596: # #
! 1597: # entree : a7@(4) pointe sur i2 de type R #
! 1598: # a7@(8) pointe sur r1 de type R #
! 1599: # sortie : d0.l contient :1 si i2>r1,0 si i2=r1,-1 sinon #
! 1600: # d1,a0,a1 sont sauvegardes #
! 1601: # #
! 1602: #===================================================================#
! 1603:
! 1604: _cmpir: link a6,#0
! 1605: moveml d1-d4/a0-a3,sp@-
! 1606: movl a6@(8),a2
! 1607: movl a6@(12),a1 | a1 et a2 pointent sur r1 et i2
! 1608: movb a1@(4),d1
! 1609: movb d1,d4
! 1610: movb a2@(4),d2
! 1611: eorb d2,d4
! 1612: bpl 1$
! 1613: moveq #1,d0
! 1614: tstb d2
! 1615: bpl 2$
! 1616: moveq #-1,d0
! 1617: 2$: bra cmpirf
! 1618: | ici d4.b >= 0
! 1619: 1$: tstb d1
! 1620: bne 3$
! 1621: moveq #1,d0
! 1622: tstb d2
! 1623: bne 4$
! 1624: moveq #0,d0
! 1625: 4$: bra cmpirf
! 1626: | ici faire copie de i2 en type R
! 1627: 3$: movw a1@(2),d0 | allouer memoire pour copie de i2
! 1628: bsr getr
! 1629: movl a0,a3
! 1630: movl a0,sp@- | empiler adresse copie
! 1631: movl a2,sp@- | empiler adresse i2
! 1632: bsr _affir
! 1633: addql #8,sp | depiler
! 1634: movl a1,sp@- | empiler adresse r1
! 1635: movl a0,sp@- | empiler adresse copie
! 1636: bsr _cmprr
! 1637: addql #8,sp | depiler
! 1638: movl a3,a0
! 1639: bsr giv | rendre copie
! 1640: cmpirf: moveml sp@+,d1-d4/a0-a3
! 1641: unlk a6
! 1642: rts
! 1643:
! 1644: #===================================================================#
! 1645: # #
! 1646: # Comparaison : reel et entier court #
! 1647: # #
! 1648: # entree : a7@(4) pointe sur r2 de type R #
! 1649: # a7@(8) contient s1 #
! 1650: # sortie : d0.l contient le signe de r2 - s1 #
! 1651: # aucun autre registre n'est affecte #
! 1652: # #
! 1653: #===================================================================#
! 1654:
! 1655: _cmprs: movl sp@(4),sp@-
! 1656: movl sp@(12),sp@-
! 1657: bsr _cmpsr
! 1658: addql #8,sp
! 1659: negl d0
! 1660: rts
! 1661:
! 1662: #===================================================================#
! 1663: # #
! 1664: # Comparaison : reel et entier #
! 1665: # #
! 1666: # entree : a7@(4) pointe sur r2 de type R #
! 1667: # a7@(8) contient i1 #
! 1668: # sortie : d0.l contient le signe de r2 - i1 #
! 1669: # aucun autre registre n'est affecte #
! 1670: # #
! 1671: #===================================================================#
! 1672:
! 1673: _cmpri: movl sp@(4),sp@-
! 1674: movl sp@(12),sp@-
! 1675: bsr _cmpir
! 1676: addql #8,sp
! 1677: negl d0
! 1678: rts
! 1679:
! 1680: #===================================================================#
! 1681: # #
! 1682: # Comparaison : reel et reel #
! 1683: # #
! 1684: # entree : a7@(4) pointe sur r2 de type R #
! 1685: # a7@(8) pointe sur r1 de type R #
! 1686: # sortie : d0.l contient :1 si r2>r1,0 si r2=r1,-1 sinon #
! 1687: # d1,a0,a1 sont sauvegardes #
! 1688: # #
! 1689: #===================================================================#
! 1690:
! 1691: _cmprr: link a6,#0
! 1692: moveml d1-d5/a1-a2,sp@-
! 1693: movl a6@(8),a2
! 1694: movl a6@(12),a1 | a1 et a2 pointent sur r1 et r2
! 1695: movb a1@(4),d1
! 1696: movb d1,d4
! 1697: movb a2@(4),d2
! 1698: eorb d2,d4
! 1699: bpl 1$
! 1700: | ici d4.b < 0
! 1701: moveq #1,d0
! 1702: tstb d2
! 1703: bpl 2$
! 1704: moveq #-1,d0
! 1705: 2$: bra cmprrf
! 1706: | ici d4.b >= 0
! 1707: 1$: tstb d1
! 1708: bne 3$
! 1709: moveq #1,d0
! 1710: tstb d2
! 1711: bne 4$
! 1712: moveq #0,d0
! 1713: 4$: bra cmprrf
! 1714: 3$: tstb a2@(4)
! 1715: bne 5$
! 1716: moveq #-1,d0
! 1717: bra cmprrf
! 1718: | ici r2 <> 0
! 1719: 5$: moveq #1,d0
! 1720: movw a1@(2),d1
! 1721: movw a2@(2),d2
! 1722: cmpw d1,d2
! 1723: bpl 6$
! 1724: exg d1,d2
! 1725: exg a1,a2
! 1726: moveq #-1,d0
! 1727: 6$: tstb a2@(4)
! 1728: bpl 7$
! 1729: negl d0
! 1730: 7$: movl a1@(4),d5
! 1731: andl #0xffffff,d5
! 1732: movl a2@(4),d3
! 1733: andl #0xffffff,d3
! 1734: cmpl d5,d3
! 1735: bpl 8$
! 1736: 10$: negl d0
! 1737: bra cmprrf
! 1738: 8$: bne cmprrf
! 1739: subw d1,d2
! 1740: subqw #3,d1
! 1741: addql #8,a1
! 1742: addql #8,a2
! 1743: 9$: cmpml a1@+,a2@+
! 1744: dbne d1,9$
! 1745: bcs 10$
! 1746: beq 11$
! 1747: bra cmprrf
! 1748: 12$: tstl a2@+
! 1749: 11$: dbne d2,12$
! 1750: bne cmprrf
! 1751: moveq #0,d0
! 1752: cmprrf: moveml sp@+,d1-d5/a1-a2
! 1753: unlk a6
! 1754: rts
! 1755:
! 1756:
! 1757:
! 1758:
! 1759:
! 1760: #*******************************************************************#
! 1761: #*******************************************************************#
! 1762: #** **#
! 1763: #** PROGRAMMES D'ADDITION **#
! 1764: #** **#
! 1765: #*******************************************************************#
! 1766: #*******************************************************************#
! 1767:
! 1768:
! 1769:
! 1770:
! 1771:
! 1772: #===================================================================#
! 1773: # #
! 1774: # Addition generale #
! 1775: # #
! 1776: # entree : a7@(4) pointe sur n2 de type I ou R #
! 1777: # a7@(8) pointe sur n1 de type I ou R #
! 1778: # sortie : d0 pointe sur n2 + n1 de type I ou R (zone creee) #
! 1779: # interdit : type S #
! 1780: # precision : voir les formules des routines specalisees #
! 1781: # #
! 1782: #===================================================================#
! 1783:
! 1784: _mpadd: movl sp@(4),a0
! 1785: movl sp@(8),a1 | a1 et a0 pointent sur n1 et n2
! 1786: movb a0@,d0
! 1787: movb a1@,d1 | d1.b et d0.b contiennent T1 et T2
! 1788: cmpb d1,d0
! 1789: ble 1$
! 1790: | ici T2 > T1
! 1791: exg a1,a0
! 1792: exg d1,d0
! 1793: movl a0,sp@(4)
! 1794: movl a1,sp@(8)
! 1795: | ici T2 <= T1
! 1796: 1$: cmpb #1,d1
! 1797: beq _addii | ici T1 = T2 = I
! 1798: 2$: cmpb #2,d0
! 1799: beq _addrr | ici T1 = T2 = R
! 1800: bra _addir
! 1801:
! 1802: #===================================================================#
! 1803: # #
! 1804: # Addition (par valeur) #
! 1805: # #
! 1806: # entree : a7@(4) pointe sur n2 de type I ou R #
! 1807: # a7@(8) pointe sur n1 de type I ou R #
! 1808: # a7@(12) pointe sur n3 de type I ou R #
! 1809: # sortie : la zone pointee par a7@(12) contient n2+n1 #
! 1810: # interdit : type S #
! 1811: # #
! 1812: #===================================================================#
! 1813:
! 1814: _mpaddz:lea _mpadd,a0
! 1815: bra mpopz
! 1816:
! 1817: | addition S+S=I ou R
! 1818:
! 1819: _addssz:lea _addss,a0
! 1820: bra mpopz
! 1821:
! 1822: | addition S+I=I ou R
! 1823:
! 1824: _addsiz:lea _addsi,a0
! 1825: bra mpopz
! 1826:
! 1827: | addition S+R=R sinon erreur
! 1828:
! 1829: _addsrz:lea _addsr,a0
! 1830: bra mpopz
! 1831:
! 1832: | addition I+I=I ou R
! 1833:
! 1834: _addiiz:lea _addii,a0
! 1835: bra mpopz
! 1836:
! 1837: | addition I+R=R sinon erreur
! 1838:
! 1839: _addirz:lea _addir,a0
! 1840: bra mpopz
! 1841:
! 1842: | addition R+R=R sinon erreur
! 1843:
! 1844: _addrrz:lea _addrr,a0
! 1845: bra mpopz
! 1846:
! 1847: #===================================================================#
! 1848: # #
! 1849: # Addition : entier court + entier court = entier #
! 1850: # #
! 1851: # entree : a7@(4) contient s2 de type S #
! 1852: # a7@(8) contient s1 de type S #
! 1853: # sortie : d0 pointe sur s1+s2 de type I(zone cree) #
! 1854: # remarque : s1 + s2 = s0 est interdit #
! 1855: # #
! 1856: #===================================================================#
! 1857:
! 1858: _addss: link a6,#-2
! 1859: movl d2,sp@-
! 1860: movl a6@(8),d1
! 1861: movl a6@(12),d2
! 1862: addl d2,d1 | d1.l contient s2 + s1
! 1863: bne 1$
! 1864: | ici d1.l=0
! 1865: bvs 2$
! 1866: | ici s1+s2=0
! 1867: movl _gzero,d0
! 1868: bra addssg
! 1869: | ici s1+s2=-2^32 (s1=s2=-2^31)
! 1870: 2$: movw #4,d0
! 1871: bsr geti
! 1872: movl #0xff000004,a0@(4)
! 1873: movl #1,a0@(8)
! 1874: clrl a0@(12)
! 1875: bra addssf
! 1876: | ici d1.l<>0
! 1877: 1$: movw #3,d0
! 1878: bsr geti
! 1879: movl #0x1000003,a0@(4)
! 1880: addl a6@(8),d2 | repositionne les indicateurs
! 1881: bvs 3$
! 1882: | ici pas d'overflow
! 1883: bmi 4$ | d1 donne bien le signe du resultat
! 1884: bra 5$
! 1885: | ici overflow
! 1886: 3$: bcc 5$ | le carry donne le signe du resultat
! 1887: 4$: negl d1
! 1888: movb #0xff,a0@(4)
! 1889: 5$: movl d1,a0@(8)
! 1890: addssf: movl a0,d0 | d0 pointe sur resultat
! 1891: addssg: movl sp@,d2
! 1892: unlk a6
! 1893: rts
! 1894:
! 1895: #===================================================================#
! 1896: # #
! 1897: # Addition : entier court + entier = entier #
! 1898: # #
! 1899: # entree : a7@(4) contient s2 de type S #
! 1900: # a7@(8) pointe sur i1 de type I #
! 1901: # sortie : d0 pointe sur s2 + i1 de type I (zone creee) #
! 1902: # #
! 1903: #===================================================================#
! 1904:
! 1905: _addsi: link a6,#0
! 1906: moveml d2-d4/a2,sp@-
! 1907: movl a6@(12),a1 | a1 pointe sur i1
! 1908: movl a6@(8),d2 | d2.l contient s2
! 1909: bne 1$ | si s2 <> 0
! 1910: | ici s2 = 0 (i1 + s2 = i1)
! 1911: movw a1@(6),d0
! 1912: bsr geti | allocation memoire pour resultat
! 1913: movl a0,d4
! 1914: subqw #2,d0 | compteur de boucle pour recopie de i1
! 1915: addql #4,a0
! 1916: addql #4,a1
! 1917: 2$: movl a1@+,a0@+ | recopie de i1
! 1918: dbra d0,2$
! 1919: bra addsif
! 1920: | ici s2 <> 0
! 1921: 1$: tstb a1@(4)
! 1922: bne 3$ | si i1 <> 0
! 1923: | ici i1 = 0 (i1 + s2 = s2)
! 1924: moveq #3,d0
! 1925: bsr geti | allocation memoire pour resultat
! 1926: movl a0,d4
! 1927: movl #0x1000003,a0@(4)
! 1928: movl d2,a0@(8)
! 1929:
! 1930: bpl addsif
! 1931: | ici s2 < 0
! 1932: movb #0xff,a0@(4)
! 1933: negl a0@(8)
! 1934: bra addsif
! 1935: | ici s2 et i1 <> 0
! 1936: 3$: movw a1@(6),d0 | d0.w contient le1
! 1937: bsr geti
! 1938: movl a0,d4
! 1939: movw a1@(4),d1
! 1940: extl d1 | d1.l contient signe de i1
! 1941: lea a0@(0,d0:w:4),a0
! 1942: lea a1@(0,d0:w:4),a2| a0 pointe fin du resultat;a2 fin de i1
! 1943: moveq #0,d3
! 1944: subqw #3,d0 | d0.w compteur boucle addition
! 1945: eorl d2,d1 | comparaison signes i1 et s2
! 1946: bmi susi | si i1 * s2 < 0
! 1947: | ici i1 * s2 > 0
! 1948: tstl d2
! 1949: bpl 51$ | valeur absolue de s2
! 1950: negl d2
! 1951: 51$: addl a2@-,d2
! 1952: bra 4$ | boucle d'addition
! 1953: 5$: movl d2,a0@-
! 1954: movl a2@-,d2
! 1955: addxl d3,d2
! 1956: 4$: dbra d0,5$
! 1957: bcc 6$ | ici retenue finale
! 1958: movl d2,a0@- | mise a jour dernier long mot
! 1959: moveq #1,d0
! 1960: bsr geti | allocation un long mot supplementaire
! 1961: movl a0,d4
! 1962: movl a0@(4),a0@
! 1963: addqw #1,a0@(2) | mise a jour premier long mot code
! 1964: cmpw #0x7fff,a0@(2)
! 1965: bls 7$
! 1966: | ici debordement
! 1967: movl #adder1,sp@-
! 1968: jsr _pari_err
! 1969: 7$: movw a0@(2),a0@(6) | mise longueur effective
! 1970: movw a1@(4),a0@(4) | signe du resultat
! 1971: movl #1,a0@(8) | mise a jour retenue finale
! 1972: bra 8$
! 1973: | ici pas de retenue finale
! 1974: 6$: movl d2,a0@- | mise a jour dernier long mot
! 1975: subqw #8,a0
! 1976: movw a0@(2),a0@(6) | longueur effective
! 1977: movw a1@(4),a0@(4) | signe du resultat
! 1978: 8$: movl a0,d4
! 1979: addsif: movl d4,d0 | d0 pointe sur resultat
! 1980: moveml sp@+,d2-d4/a2
! 1981: unlk a6
! 1982: rts
! 1983: | ici i1 * s2 < 0 : soustraction
! 1984: susi: movl d2,d1 | d1.l recoit s2
! 1985: bpl 6$
! 1986: negl d1 | d1.l recoit |s2|
! 1987: 6$: movl a2@-,d2
! 1988: subl d1,d2 | amorcage de la soustraction
! 1989: bra 1$
! 1990: | boucle de soustraction
! 1991: 2$: movl d2,a0@-
! 1992: movl a2@-,d2
! 1993: subxl d3,d2
! 1994: 1$: dbra d0,2$
! 1995: bcc 3$
! 1996: | ici retenue finale:longueur resultat=3
! 1997: negl d2
! 1998: movl d2,a0@-
! 1999: subql #8,a0 | a0 pointe sur resultat
! 2000: movw #3,a0@(6) | mise a jour longueur effective
! 2001: movb a1@(4),d2
! 2002: negb d2
! 2003: movb d2,a0@(4) | mise a jour signe (-|i1|)
! 2004: bra addsif
! 2005: | ici pas de retenue finale
! 2006: 3$: tstl d2
! 2007: beq 4$
! 2008: | ici d2 <> 0
! 2009: movl d2,a0@-
! 2010: movl a1@(4),a0@- | mise a jour second long mot code
! 2011: bra addsif
! 2012: | ici d2 = 0
! 2013: 4$: movl a1@(4),a0@-
! 2014: subqw #1,a0@(2)
! 2015: cmpw #2,a0@(2)
! 2016: bne 5$
! 2017: | ici L1 = 1 ; le resultat est 0
! 2018: clrb a0@
! 2019: 5$: movl a0@(-8),a0@-
! 2020: subqw #1,a0@(2)
! 2021: movl a0,d4
! 2022: addql #4,_avma | mise a jour pile PARI
! 2023: bra addsif
! 2024:
! 2025: #===================================================================#
! 2026: # #
! 2027: # Addition : entier + entier = entier #
! 2028: # #
! 2029: # entree : a7@(4) pointe sur i2 de type I #
! 2030: # a7@(8) pointe sur i1 de type I #
! 2031: # sortie : d0 pointe sur i2 + i1 de type I (zone creee) #
! 2032: # #
! 2033: #===================================================================#
! 2034:
! 2035: _addii: link a6,#0
! 2036: moveml d2-d7/a2-a4,sp@-
! 2037: movl a6@(8),a2 | a2 pointe sur i2
! 2038: movl a6@(12),a1 | a1 pointe sur i1
! 2039: moveq #0,d2
! 2040: moveq #0,d1
! 2041: movw a2@(6),d2
! 2042: movw a1@(6),d1 | d1.w recoit le1 et d2.w recoit le2
! 2043: cmpw d1,d2
! 2044: bcc 1$
! 2045: exg a1,a2
! 2046: exg d1,d2 | si L2 < L1 ,echanger a1,a2 et d1,d2
! 2047: | ici L2 >= L1
! 2048: 1$: tstb a1@(4)
! 2049: bne 2$ | ici i1 = 0 : i1 + i2 = i2
! 2050: movw a2@(6),d0
! 2051: bsr geti | allocation memoire pour recopie de i2
! 2052: subqw #2,d0 | compteur de recopie
! 2053: movl a0,a1
! 2054: addql #4,a1
! 2055: addql #4,a2
! 2056: | boucle de recopie
! 2057: 3$: movl a2@+,a1@+
! 2058: dbra d0,3$
! 2059: bra addiif
! 2060: | ici i1 <> 0 ( donc i2 <> 0)
! 2061: 2$: movb a1@(4),d3
! 2062: movb a2@(4),d4
! 2063: eorb d4,d3 | d3 contient signe de i2 * i1
! 2064: bmi suii
! 2065: | ici i2 * i1 > 0
! 2066: movw d2,d0
! 2067: bsr geti | allocation memoire le2 longs mots
! 2068: lea a0@(0,d0:w:4),a0| a0 pointe fin du resultat
! 2069: lea a2@(0,d0:w:4),a2| a2 pointe fin de i2
! 2070: lea a1@(0,d1:w:4),a1| a1 pointe fin de i1
! 2071: subw d1,d2 | d2.w contient L2-L1
! 2072: subqw #3,d1 | d1.w contient L1-1 (compteur)
! 2073: moveq #0,d4
! 2074: | ici premiere boucle d'addition
! 2075: 4$: movl a1@-,d0
! 2076: movl a2@-,d5
! 2077: addxl d5,d0
! 2078: movl d0,a0@-
! 2079: dbra d1,4$
! 2080: roxrw d4,d0 | mise a jour dernier long mot
! 2081: bra 5$
! 2082: | ici deuxieme boucle:propagation carry
! 2083: 6$: movl a2@-,d0
! 2084: addxl d4,d0
! 2085: movl d0,a0@-
! 2086: roxrw d4,d0
! 2087: 5$: dbcc d2,6$
! 2088: bcs 7$ | si carry jusqu'a la fin
! 2089: | ici pas de carry
! 2090: bra 8$
! 2091: | ici troisieme boucle:recopie mantisse
! 2092: 9$: movl a2@-,a0@-
! 2093: 8$: dbra d2,9$
! 2094: | ici pas de carry finale
! 2095: movl a2@-,a0@-
! 2096: subql #4,a0
! 2097: bra addiif
! 2098: | ici carry finale
! 2099: 7$: movw a2@(-2),d2
! 2100: addqw #1,d2
! 2101: cmpw #0x8000,d2
! 2102: bcs 10$
! 2103: | ici debordement
! 2104: movl #adder2,sp@-
! 2105: jsr _pari_err
! 2106: | ici demander 1 long mot en plus
! 2107: 10$: moveq #1,d0
! 2108: bsr geti
! 2109: movl #1,a0@(8) | mise retenue
! 2110: movl a0@(4),a0@
! 2111: movw d2,a0@(2) | mise a jour premier long mot code
! 2112: movl a2@-,a0@(4)
! 2113: movw d2,a0@(6) | idem deuxieme long mot code
! 2114: addiif: movl a0,d0 | d0 pointe sur resultat
! 2115: addiig: moveml sp@+,d2-d7/a2-a4
! 2116: unlk a6
! 2117: rts
! 2118: | ici i2 * i1 < 0 : soustraction
! 2119: suii: movl a1,a3
! 2120: movl a2,a4 | a3,a4 pointent sur i1,i2
! 2121: subw d1,d2 | d2.w contient L2-L1
! 2122: bne 1$
! 2123: | ici L2=L1
! 2124: subqw #3,d1 | d1.w contient L1-1
! 2125: addql #8,a3
! 2126: addql #8,a4 | a3,a4 pointent debut mantisses i1,i2
! 2127: 2$: cmpml a3@+,a4@+
! 2128: dbne d1,2$ | on compare |i1| et |i2|
! 2129: bhi 1$ | si |i2| > |i1|
! 2130: | ici |i2| < |i1|
! 2131: bne 3$
! 2132: | ici |i2| = |i1| : i2 + i1 = 0
! 2133: movl _gzero,d0
! 2134: bra addiig
! 2135: | ici |i2| < |i1| : echanger i2 et i1
! 2136: 3$: exg a1,a2
! 2137: | ici |i2| > |i1| (signe i2=signe resultat)
! 2138: 1$: movw a2@(6),d0
! 2139: bsr geti | allocation memoire le2 longs mots
! 2140: movw a1@(6),d1 | d1.w contient L1+2
! 2141: movl a0,sp@- | empilage adresse resultat
! 2142: movb a2@(4),d7 | d7.b contient signe resultat
! 2143: lea a1@(0,d1:w:4),a1
! 2144: lea a2@(0,d0:w:4),a2
! 2145: lea a0@(0,d0:w:4),a0| a0,a1,a2 pointent fin resultat,i1,i2
! 2146: subl d3,d3 | initialisation bit X
! 2147: subqw #3,d1 | d1.w contient L1-1 (compteur)
! 2148: | premiere boucle de soustraction
! 2149: 4$: movl a2@-,d0
! 2150: movl a1@-,d5
! 2151: subxl d5,d0
! 2152: movl d0,a0@-
! 2153: dbra d1,4$
! 2154: roxrw d3,d0 | restauration du bit C
! 2155: bra 5$
! 2156: | deuxieme boucle:propagation carry
! 2157: 6$: movl a2@-,d5
! 2158: subxl d3,d5
! 2159: movl d5,a0@-
! 2160: roxrw d3,d0
! 2161: 5$: dbcc d2,6$
! 2162: bra 7$
! 2163: | troisieme boucle:recopie fin i2
! 2164: 8$: movl a2@-,a0@-
! 2165: 7$: dbra d2,8$
! 2166: movl sp@+,a0 | depilage adresse resultat
! 2167: movw a0@(2),d1 | d1.w contient lon eff du resultat
! 2168: moveq #0,d2
! 2169: movw d1,d2 | d2.w idem
! 2170: addql #8,a0 | a0 pointe mantisse resultat
! 2171: 9$: tstl a0@+
! 2172: dbne d1,9$ | chasse aux '0' partie gauche resultat
! 2173: subql #4,a0 | a0 pointe 1er long mot non nul
! 2174: movl d1,a0@- | mise a jour longueur effective
! 2175: movb d7,a0@ | mise a jour signe
! 2176: movw d1,a0@- | mise a jour longueur totale
! 2177: movw #0x100,a0@- | mise a jour type
! 2178: subw d1,d2
! 2179: lsll #2,d2
! 2180: addl d2,_avma | mise a jour pile PARI
! 2181: bra addiif
! 2182:
! 2183: #===================================================================#
! 2184: # #
! 2185: # Addition : entier court + reel = reel #
! 2186: # #
! 2187: # entree : a7@(4) contient s2 de type S #
! 2188: # a7@(8) pointe sur r1 de type R #
! 2189: # sortie : d0 pointe sur s2 + r1 de type R (zone creee) #
! 2190: # #
! 2191: #===================================================================#
! 2192:
! 2193: _addsr: link a6,#-12 | 3 lgmots pour transformer s2 en type I
! 2194: movl a6@(8),d1 | d1.l contient s2
! 2195: bne 1$
! 2196: | ici s2 = 0
! 2197: movl #0x1000002,a6@(-12)
! 2198: movl #2,a6@(-8)
! 2199: bra 3$
! 2200: | ici s2 <> 0
! 2201: 1$: bmi 2$
! 2202: movl #0x1000003,a6@(-12)
! 2203: movl #0x1000003,a6@(-8)
! 2204: movl d1,a6@(-4)
! 2205: bra 3$
! 2206: | ici s2 < 0
! 2207: 2$: movl #0x1000003,a6@(-12)
! 2208: movl #0xff000003,a6@(-8)
! 2209: negl d1
! 2210: movl d1,a6@(-4)
! 2211: 3$: movl a6@(12),sp@-
! 2212: pea a6@(-12)
! 2213: bsr _addir
! 2214: unlk a6
! 2215: rts
! 2216:
! 2217: #===================================================================#
! 2218: # #
! 2219: # Addition : entier + reel = reel #
! 2220: # #
! 2221: # entree : a7@(4) pointe sur i2 de type I #
! 2222: # a7@(8) pointe sur r1 de type R #
! 2223: # sortie : d0 pointe sur i2 + r1 de type R (zone creee) #
! 2224: # precision : si exp2>=exp1 , L = L1 + int((exp2-exp1)/32) + 1#
! 2225: # si exp2<exp1 , L = L1 #
! 2226: # i2 est transforme en un reel #
! 2227: # #
! 2228: #===================================================================#
! 2229:
! 2230: _addir: link a6,#-4 | var. locale pour copie i2 en r2
! 2231: moveml d2-d3/a2,sp@-
! 2232: movl a6@(8),a2
! 2233: movl a6@(12),a1 | a1,a2 pointent sur r1,i2
! 2234: tstb a2@(4)
! 2235: bne 1$
! 2236: | ici i2 = 0 ( i2 + r1 = r1)
! 2237: 6$: movw a1@(2),d0
! 2238: bsr getr
! 2239: movl a0,a6@(-4) | sauve adresse resultat
! 2240: addql #4,a1
! 2241: addql #4,a0
! 2242: subqw #2,d0
! 2243: | boucle de copie d'un reel
! 2244: 4$: movl a1@+,a0@+
! 2245: dbra d0,4$
! 2246: bra addirf
! 2247: | ici i2 <> 0
! 2248: 1$: tstb a1@(4)
! 2249: bne 3$
! 2250: | ici r1 = 0 (i2 + r1 = i2)
! 2251: movl a1@(4),d1
! 2252: subl #0x800000,d1
! 2253: asrl #5,d1
! 2254: moveq #0,d0
! 2255: movw a2@(6),d0
! 2256: subl d1,d0 | d0.l contient L2-[exp1/32]
! 2257: cmpl #3,d0
! 2258: bcs 2$
! 2259: cmpl #0x8000,d0
! 2260: bcc 2$
! 2261: bsr getr
! 2262: movl a0,a6@(-4)
! 2263: movl a0,sp@-
! 2264: movl a2,sp@-
! 2265: bsr _affir | le resultat est i2 en type R
! 2266: addql #8,sp | de longueur L2-[exp1/32]
! 2267: bra addirf
! 2268: | ici i2 et r1 <> 0
! 2269: 3$: movl a2@(8),d0
! 2270: bfffo d0{#0:#0},d1 | d1.l recoit nb de shifts (=s)
! 2271: moveq #0,d0
! 2272: movw a2@(6),d0
! 2273: subqw #2,d0
! 2274: lsll #5,d0
! 2275: subl d1,d0
! 2276: subql #1,d0 | d0.l recoit 32*L2-s-1 = exp2
! 2277: moveq #0,d3
! 2278: movw a1@(2),d3 | d3.w recoit l1
! 2279: movl a1@(4),d2
! 2280: andl #0xffffff,d2
! 2281: subl #0x800000,d2 | d2.l recoit exp1
! 2282: subl d0,d2 | d2.l recoit exp1-exp2
! 2283: ble 5$
! 2284: | ici exp1 > exp2
! 2285: lsrl #5,d2 | d2.l recoit L3=[(exp1-exp2)/32]
! 2286: subl d2,d3 | d3.l recoit L1-L3+2
! 2287: cmpl #2,d3
! 2288: ble 6$ | si L1 <= L3 alors:r1+i2=r1
! 2289: | ici L1 > L3
! 2290: 7$: movl _avma,sp@- | empilage pile PARI
! 2291: movw d3,d0
! 2292: bsr getr | allocation memoire L1-L3+2 lg mots
! 2293: | pour ecrire i2 en type R
! 2294: movl a0,sp@- | empilage r2 (copie de i2)
! 2295: movl a2,sp@- | empilage i2
! 2296: bsr _affir
! 2297: movl a1,sp@ | empilage r1
! 2298: bsr _addrr
! 2299: movl d0,a0 | a0 pointe sur r2 + r1
! 2300: movw a0@(2),d0 | d0.w contient lr (longueur resultat)
! 2301: subqw #1,d0 | d0.w contient lr-1 (compteur pile)
! 2302: movl sp@(4),a1 | a1 pointe sur r2
! 2303: addql #8,sp | depilage r1 et r2
! 2304: moveq #0,d1
! 2305: movw a1@(2),d1
! 2306: lsll #2,d1 | d1.l contient 4*l2 (nb d'octets a
! 2307: | desallouer dans pile PARI)
! 2308:
! 2309: movl sp@+,a0 | a0 pointe sur ancien _avma
! 2310: | boucle de transfert du resultat
! 2311: 8$: movl a1@-,a0@-
! 2312: dbra d0,8$
! 2313: addl d1,_avma | mise a jour pile PARI
! 2314: movl a0,a6@(-4)
! 2315: bra addirf
! 2316: | ici exp1 <= exp2
! 2317: 5$: negl d2
! 2318: lsrl #5,d2 | d2.l recoit L3=[(exp2-exp1)/32]
! 2319: addw d2,d3
! 2320: addqw #1,d3 | d3.w recoit L1+L3+1
! 2321: cmpw #0x8000,d3
! 2322: bcs 7$
! 2323: | ici debordement
! 2324: 2$: movl #adder3,sp@-
! 2325: jsr _pari_err
! 2326: addirf: movl a6@(-4),d0 | d0 pointe sur resultat
! 2327: moveml sp@+,d2-d3/a2
! 2328: unlk a6
! 2329: rts
! 2330:
! 2331: #===================================================================#
! 2332: # #
! 2333: # Addition : reel + reel = reel #
! 2334: # #
! 2335: # entree : a7@(4) pointe sur r2 de type R #
! 2336: # a7@(8) pointe sur r1 de type R #
! 2337: # sortie : d0 pointe sur r2 + r1 de type R (zone creee) #
! 2338: # precision : L = inf ( L2 , L1 + [(exp2-exp1)/32]) #
! 2339: # si exp2 >= exp1 (sinon echanger r1 et r2) #
! 2340: # #
! 2341: #===================================================================#
! 2342:
! 2343: _addrr: link a6,#-16
! 2344: moveml d2-d7/a2-a4,sp@-
! 2345: movl a6@(8),a2 | a2 pointe sur r2
! 2346: movl a6@(12),a1 | a1 pointe sur r1
! 2347: tstb a2@(4)
! 2348: bne 1$
! 2349: | ici r2 = 0 (r2 + r1 = r1)
! 2350: 4$: tstb a1@(4)
! 2351: bne 22$
! 2352: | ici r2=r1=0
! 2353: movl a1@(4),d1
! 2354: cmpl a2@(4),d1
! 2355: bgt 23$
! 2356: movl a2@(4),d1 | d1.l contient sup(fexp1,fexp2)
! 2357: 23$: moveq #3,d0
! 2358: bsr getr
! 2359: movl a0,a6@(-8)
! 2360: movl d1,a0@(4)
! 2361: clrl a0@(8)
! 2362: bra addrrf
! 2363: | ici r2 = 0 et r1 <> 0
! 2364: 22$: moveq #0,d0
! 2365: movl a2@(4),d2 | d2.l contient fexp2
! 2366: movl a1@(4),d1
! 2367: andl #0xffffff,d1 | d1.l contient fexp1
! 2368: subl d2,d1 | d1.l recoit exp1-exp2
! 2369: bcc 24$
! 2370: | ici exp2 > exp1
! 2371: moveq #3,d0
! 2372: bsr getr
! 2373: movl a0,a6@(-8) | le resultat est 0 avec exposant fexp2
! 2374: movl a2@(4),a0@(4)
! 2375: clrl a0@(8)
! 2376: bra addrrf
! 2377: | ici exp2 <= exp1
! 2378: 24$: lsrl #5,d1 | d1.l contient [(exp1-exp2)/32]
! 2379: movw a1@(2),d0
! 2380: subqw #2,d0 | d0.l contient L1
! 2381: cmpl d1,d0
! 2382: ble 25$
! 2383: movl d1,d0 | d0.l=inf(L1,[(e1-e2)/32])=L
! 2384: addql #1,d0 | le resultat est r1 en longueur:
! 2385: 25$: addql #2,d0 | L1 si L1<=[(e1-e2)/32] ou
! 2386: bsr getr
! 2387: movl a0,a6@(-8)
! 2388: addql #4,a1
! 2389: addql #4,a0
! 2390: subqw #2,d0
! 2391: 27$: movl a1@+,a0@+
! 2392: dbra d0,27$
! 2393: bra addrrf
! 2394: | ici r2 <> 0
! 2395: 1$: tstb a1@(4)
! 2396: bne 3$
! 2397: | ici r1 = 0 (r2 + r1 = r2)
! 2398: exg a2,a1
! 2399: bra 22$
! 2400: | ici r1 * r2 <> 0
! 2401: 3$: movb a1@(4),d3
! 2402: movb a2@(4),d5
! 2403: eorb d5,d3 | d3.b contient : 0 si r1 * r2 > 0
! 2404: | et est negatif sinon
! 2405: movb d3,a6@(-2) | sauvegarde du 'signe'
! 2406: movl a2@(4),d3
! 2407: andl #0xffffff,d3 | d3.l contient fexp2=e2
! 2408: movl a1@(4),d1
! 2409: andl #0xffffff,d1 | d1.l contient fexp1=e1
! 2410: subl d1,d3 | d3.l contient exp2-exp1
! 2411: beq 5$ | si e2 = e1
! 2412: bcc 6$ | si e2 > e1
! 2413: | ici e2 < e1
! 2414: exg a1,a2
! 2415: negl d3 | d3.l recoit e1-e2 > 0
! 2416: | ici e2-e1 > 0
! 2417: 6$: movw d3,d4
! 2418: andw #31,d4
! 2419: lsrl #5,d3 | e2-e1=32*L3+r ; d4.w,d3.l recoit r,L3
! 2420: moveq #0,d2
! 2421: movw a2@(2),d2
! 2422: subqw #2,d2 | d2.l recoit L2
! 2423: cmpl d2,d3
! 2424: bcs 7$
! 2425: | ici L3 >= L2 (r1 + r2 = r2)
! 2426: movw a2@(2),d0
! 2427: bsr getr
! 2428: movl a0,a6@(-8)
! 2429: addql #4,a2
! 2430: addql #4,a0
! 2431: subqw #2,d0
! 2432: 28$: movl a2@+,a0@+
! 2433: dbra d0,28$
! 2434: bra addrrf
! 2435: | ici L3 < L2
! 2436: 7$: moveq #0,d1
! 2437: movw a1@(2),d1
! 2438: subqw #2,d1 | d1.l recoit L1
! 2439: movl d3,d5
! 2440: addl d1,d5 | d5.l recoit L1 + L3
! 2441: cmpl d2,d5
! 2442: bcs 8$ | si L1 + L3 < L2
! 2443: | ici L3 < L2 <= L1 + L3
! 2444: movb #1,a6@(-4) | a6@(-4) flag contenant :
! 2445: | 0 si L1+L3 < L2 faire alors copie r1
! 2446: | 1 si L3 < L2 <= L1+L3 et idem
! 2447: | 2 si e1 = e2 et alors pas de copie
! 2448: movw d2,d0
! 2449: addqw #2,d0 | d0.w recoit l2
! 2450: bsr getr | allocation L2+2 lgmots pour resultat
! 2451: movl a0,a6@(-8) | adresse resultat dans var. locale
! 2452: movw d2,d5
! 2453: subw d3,d5 | d5.w contient L2 - L3
! 2454: movw d5,d0
! 2455: addqw #1,d0 | d0.w contient L2 - L3 + 1
! 2456: bsr getr | allocation L2-L3+1 pour copie r1 avec
! 2457: | un unique longmot code
! 2458: subqw #2,d0 | d0.w contient L2 - L3 - 1
! 2459: movw a2@(2),d1
! 2460: lea a2@(0,d1:w:4),a2| a2 pointe fin de r2
! 2461: bra 9$
! 2462: | ici L1 + L3 < L2
! 2463: 8$: clrb a6@(-4) | a6@(-4) mis a 0
! 2464: movw d5,d0
! 2465: addqw #3,d0 | d0.w contient L1 + L3 + 3
! 2466: bsr getr | allocation pour resultat
! 2467: movl a0,a6@(-8) | adresse resultat dans var. locale
! 2468: lea a2@(0,d0:w:4),a2| a2 pointe ou necessaire !!
! 2469: movw a1@(2),d5 | d5.w contient L1 + 2
! 2470: movw d5,d0 | d0.w contient L1 + 2
! 2471: subqw #2,d5 | d5.w contient L1
! 2472: bsr getr | allocation L1+2 pour copie r1 avec
! 2473: | un seul lgmot code
! 2474: subqw #3,d0 | d0.w contient L1 - 1
! 2475: 9$: movl a0,a6@(-12) | adresse copie r1 dans var. locale
! 2476: addql #4,a0
! 2477: movl a0,a3 | a0 et a3 pointent sur debut copie
! 2478: addql #8,a1 | a1 pointe debut mantisse r1
! 2479: 29$: movl a1@+,a0@+
! 2480: dbra d0,29$ | boucle copie r1
! 2481: tstw d4 | test de r = nb de shifts
! 2482: bne 10$
! 2483: | ici r = 0 ; pas de shift a faire
! 2484: | a0 pointe fin copie r1
! 2485: | a3 pointe debut mantisse copie r1
! 2486: moveq #0,d7
! 2487: movw a3@(-2),d7
! 2488: subqw #1,d7 | d7.w contient longueur mantisse copie
! 2489: movw d7,d2
! 2490: subqw #1,d2 | d2.w = compteur boucle addition
! 2491: lea a3@(0,d7:w:4),a3| a3 pointe fin copie r1
! 2492: movl a3,a1 | a1 aussi
! 2493: bra 11$
! 2494: | ici r <> 0 ; shift a faire
! 2495: 10$: subqw #1,d5
! 2496: movew d5,d2 | d5.w et d2.w = compteur boucle shift
! 2497: movl #-1,d6
! 2498: lsrl d4,d6 | masque de shift:0...01...1; avec r '0'
! 2499: moveq #0,d0
! 2500: | boucle de shift de copie de r1
! 2501: 12$: movl a3@,d7
! 2502: rorl d4,d7
! 2503: movl d7,d1
! 2504: andl d6,d1
! 2505: subl d1,d7
! 2506: addl d1,d0
! 2507: movl d0,a3@+
! 2508: movl d7,d0
! 2509: dbra d5,12$
! 2510: movl a3,a1
! 2511: tstb a6@(-4)
! 2512: bne 11$ | si a6@(-4) <> 0
! 2513: | ici a6@(-4) = 0
! 2514: movl d0,a1@+
! 2515: addqw #1,d2 | d2.w = compteur boucle addition
! 2516: 11$: movl a6@(-8),a0 | a0 pointe sur resultat
! 2517: moveq #0,d1
! 2518: movw a0@(2),d1
! 2519: lea a0@(0,d1:w:4),a0| a0 pointe fin du resultat
! 2520: bra 14$
! 2521: | ici e1 = e2
! 2522: 5$: movb #2,a6@(-4) | a6@(-4) recoit 2
! 2523: movl d1,a6@(-16) | a6@(-16) recoit e1=e2 biaise
! 2524: movw a1@(2),d0
! 2525: cmpw a2@(2),d0
! 2526: bcs 15$
! 2527: movw a2@(2),d0
! 2528: 15$: bsr getr | allocation inf (l1,l2) pour resultat
! 2529: movl a0,a6@(-8) | adresse du resultat dans var. locale
! 2530: moveq #0,d2
! 2531: movw d0,d2
! 2532: movl d2,d0
! 2533: subqw #3,d2
! 2534: moveq #0,d3
! 2535: movl a2,a4
! 2536: movl a1,a3
! 2537: lea a0@(0,d0:w:4),a0| a0 pointe fin resultat
! 2538: lea a1@(0,d0:w:4),a1| a1 pointe fin de r1 ou copie
! 2539: lea a2@(0,d0:w:4),a2| a2 pointe fin de r2
! 2540:
! 2541: | zone des boucles d'addition
! 2542:
! 2543: | conditions initiales :
! 2544: | a0 pointe fin resultat
! 2545: | a1 pointe fin r1 ou copie
! 2546: | a2 pointe fin r2
! 2547: | d2.w contient L4-1
! 2548: | d3.w contient L3 avec L3+L4=long.res.
! 2549: 14$: subl d4,d4 | initialisation bit X
! 2550: tstb a6@(-2) | test du signe de r1*r2
! 2551: bne surr
! 2552: | ici r1 * r2 > 0
! 2553: | 1ere boucle d'addition
! 2554: 16$: movl a1@-,d1
! 2555: movl a2@-,d5
! 2556: addxl d5,d1
! 2557: movl d1,a0@-
! 2558: dbra d2,16$
! 2559: roxrw d4,d0 | remise a jour du bit C
! 2560: bcc 17$ | si pas de carry
! 2561: bra 18$ | si carry
! 2562: | 2eme boucle:propagation carry
! 2563: 19$: movl a2@-,d5
! 2564: addxl d4,d5
! 2565: movl d5,a0@-
! 2566: roxrw d4,d0 | mise a jour bit C
! 2567: 18$: dbcc d3,19$
! 2568: bcs 20$ | si carry finale
! 2569: bra 17$
! 2570: | 3eme boucle:recopie reste mantisse r2
! 2571: 30$: movl a2@-,a0@-
! 2572: 17$: dbra d3,30$
! 2573: movl a2@-,a0@- | mise signe et exposant:celui de r2
! 2574: cmpb #2,a6@(-4)
! 2575: beq addrrf | si a6@(-4) = 2
! 2576: | ici rendre copie de r1
! 2577: movl a6@(-12),a0
! 2578: bsr giv
! 2579: bra addrrf
! 2580: | ici carry finale
! 2581: 20$: movl a2@-,d1
! 2582: andl #0xffffff,d1
! 2583: addql #1,d1 | d1.l recoit fexp resultat
! 2584: cmpl #0x1000000,d1
! 2585: blt 2$
! 2586: | ici fexp>=2^24 : erreur
! 2587: movl #adder4,sp@-
! 2588: jsr _pari_err
! 2589: | ici non debordement
! 2590: 2$: cmpb #2,a6@(-4)
! 2591: beq 13$
! 2592: | ici rendre copie de r1
! 2593: movl a0,a3
! 2594: movl a6@(-12),a0
! 2595: bsr giv
! 2596: movl a3,a0
! 2597: 13$: movl d1,a0@(-4)
! 2598: movb a2@,a0@(-4) | mise a jour exp et sign resultat
! 2599: movw a0@(-6),d2
! 2600: subqw #3,d2 | compteur de shift
! 2601: movw #-1,d0
! 2602: movw d0,cc | mise a 1 des bit x et c
! 2603: 31$: roxrw a0@+
! 2604: roxrw a0@+ | boucle de mise de retenue finale et
! 2605: dbra d2,31$ | shift de 1 vers la droite mantisse
! 2606: addrrf: movl a6@(-8),d0 | d0 pointe sur resultat
! 2607: moveml sp@+,d2-d7/a2-a4
! 2608: unlk a6
! 2609: rts
! 2610: | ici faire une soustraction
! 2611: | pour conditions initiales cf.plus haut
! 2612: surr: moveq #0,d6
! 2613: movw d2,d6
! 2614: movw d2,d7
! 2615: addw d3,d7
! 2616: addqw #3,d7
! 2617: cmpb #2,a6@(-4)
! 2618: bne 1$
! 2619: | ici e2 = e1:comparer les mantisses
! 2620: addql #8,a3
! 2621: addql #8,a4
! 2622: 12$: cmpml a3@+,a4@+
! 2623: dbne d2,12$
! 2624: bhi 1$ | si |r2| > |r1|
! 2625: bne 2$ | si |r2| < |r1|
! 2626: | ici |r2| = |r1| et donc r2 + r1 = 0
! 2627: movl a6@(-8),a0 | le resultat est 0 avec comme exposant
! 2628: moveq #0,d2 | -32*inf(l1,l2)+e1
! 2629: movw a0@(2),d2
! 2630: subqw #2,d2
! 2631: lsll #5,d2
! 2632: negl d2
! 2633: addl a6@(-16),d2 | ajouter e1 biaise
! 2634: bpl 15$
! 2635: movl #adder5,sp@- | underflow dans R+R
! 2636: jsr _pari_err
! 2637: 15$: cmpl #0x1000000,d2
! 2638: blt 16$
! 2639: | ici fexp>=2^24 : erreur overflow dans R+R
! 2640: movl #adder4,sp@-
! 2641: jsr _pari_err
! 2642: 16$: bsr giv
! 2643: moveq #3,d0
! 2644: bsr getr
! 2645: movl a0,a6@(-8)
! 2646: movl d2,a0@(4)
! 2647: clrl a0@(8)
! 2648: bra addrrf
! 2649: | ici |r2| < |r1| : echanger r2 et r1
! 2650: 2$: exg a1,a2
! 2651: | ici |r2| > |r1|
! 2652: 1$: subw d2,d6
! 2653: subl d4,d4 | initialisation bit X
! 2654: | 1ere boucle de soustraction
! 2655: 3$: movl a2@-,d0
! 2656: movl a1@-,d5
! 2657: subxl d5,d0
! 2658: movl d0,a0@-
! 2659: dbra d2,3$
! 2660: roxrw d4,d0 | remise ajour bit C
! 2661: bra 4$
! 2662: | 2eme boucle:propagation carry
! 2663: 5$: movl a2@-,d5
! 2664: subxl d4,d5
! 2665: movl d5,a0@-
! 2666: roxrw d4,d0
! 2667: 4$: dbcc d3,5$
! 2668: bra 6$
! 2669: | 3eme boucle:copie reste mantisse r2
! 2670: 13$: movl a2@-,a0@-
! 2671: 6$: dbra d3,13$
! 2672: moveq #0,d3
! 2673: moveq #-1,d2
! 2674: movw d2,d3
! 2675: 14$: tstl a0@+
! 2676: dbne d2,14$ | chasse aux '0' du resultat provisoire
! 2677: | a0 pointe sur 1er lgmot non nul
! 2678: subw d2,d3 | d3.w contient de lgmots nuls
! 2679: addw d6,d3
! 2680: subl #12,a0 | a0 pointe sur resultat
! 2681: movl a0,a6@(-8)
! 2682: movl a0,a1 | a1 aussi
! 2683: cmpb #2,a6@(-4)
! 2684: beq 7$ | si pas de copie faite
! 2685: | ici rendre copie
! 2686: movl a6@(-12),a0
! 2687: bsr giv
! 2688: 7$: moveq #0,d0
! 2689: movw d3,d0
! 2690: lsll #2,d0 | d0.l = nb d'octets a 0 du result.
! 2691: addl d0,_avma | mise a jour pile PARI(rendre d3 lgmot)
! 2692: movl a1,a0 | a0 pointe sur resultat final
! 2693: movw #0x200,a0@
! 2694: subw d3,d7
! 2695: movw d7,a0@(2) | mise a jour 1er lgmot code resultat
! 2696: lsll #5,d3
! 2697: movl a0@(8),d0
! 2698: bfffo d0{#0:#0},d1 | d1.l contient nb de shifts=r
! 2699: lsll d1,d0 | normalisation 1er lgmot mantisse
! 2700: addl d1,d3
! 2701: lsll #2,d6
! 2702: subl d6,a2
! 2703: movl a2@(-4),d2
! 2704: andl #0xffffff,d2
! 2705: subl d3,d2
! 2706: movl d2,a0@(4) | calcul et mise exposant resultat
! 2707: movb a2@(-4),a0@(4) | mise signe resultat
! 2708: tstb d1
! 2709: bne 8$ | si r <> 0
! 2710: bra 9$ | si r = 0
! 2711: 8$: moveq #1,d6
! 2712: lsll d1,d6
! 2713: subql #1,d6 | masque de shift
! 2714: addql #8,a1
! 2715: subqw #3,d7 | d7.w contient L-1
! 2716: bra 10$
! 2717: | boucle de shift vers la gauche
! 2718: 11$: movl a1@(4),d2
! 2719: roll d1,d2
! 2720: movl d2,d3
! 2721: andl d6,d3
! 2722: subl d3,d2
! 2723: addl d3,d0
! 2724: movl d0,a1@+
! 2725: movl d2,d0
! 2726: 10$: dbra d7,11$
! 2727: movl d0,a1@
! 2728: 9$: bra addrrf
! 2729:
! 2730:
! 2731:
! 2732:
! 2733:
! 2734: #*******************************************************************#
! 2735: #*******************************************************************#
! 2736: #** **#
! 2737: #** PROGRAMMES DE SOUSTRACTION **#
! 2738: #** **#
! 2739: #*******************************************************************#
! 2740: #*******************************************************************#
! 2741:
! 2742:
! 2743:
! 2744:
! 2745:
! 2746: #===================================================================#
! 2747: # #
! 2748: # Soustraction generale #
! 2749: # #
! 2750: # entree : a7@(4) pointe sur n2 de type I ou R #
! 2751: # a7@(8) pointe sur n1 de type I ou R #
! 2752: # sortie : d0 pointe sur n2 - n1 de type I ou R (zone creee) #
! 2753: # interdit : type S #
! 2754: # #
! 2755: #===================================================================#
! 2756:
! 2757: _mpsub: cmpb #1,sp@(8)@
! 2758: bne 1$
! 2759: cmpb #1,sp@(4)@
! 2760: beq _subii
! 2761: bra _subri
! 2762: 1$: cmpb #1,sp@(4)@
! 2763: beq _subir
! 2764: bra _subrr
! 2765:
! 2766: #===================================================================#
! 2767: # #
! 2768: # Soustraction (par valeur) #
! 2769: # #
! 2770: # entree : a7@(4) pointe sur n2 de type I ou R #
! 2771: # a7@(8) pointe sur n1 de type I ou R #
! 2772: # a7@(12) pointe sur n3 de type I ou R #
! 2773: # sortie : la zone pointee par a7@(12) contient n2 - n1 #
! 2774: # interdit : type S #
! 2775: # #
! 2776: #===================================================================#
! 2777:
! 2778: _mpsubz:lea _mpsub,a0
! 2779: bra mpopz
! 2780:
! 2781: | soustraction S-S=I ou R
! 2782:
! 2783: _subssz:lea _subss,a0
! 2784: bra mpopz
! 2785:
! 2786: | soustraction S-I=I ou R
! 2787:
! 2788: _subsiz:lea _subsi,a0
! 2789: bra mpopz
! 2790:
! 2791: | soustraction S-R=R sinon erreur
! 2792:
! 2793: _subsrz:lea _subsr,a0
! 2794: bra mpopz
! 2795:
! 2796: | soustraction I-S=I ou R
! 2797:
! 2798: _subisz:lea _subis,a0
! 2799: bra mpopz
! 2800:
! 2801: | soustraction I-I=I ou R
! 2802:
! 2803: _subiiz:lea _subii,a0
! 2804: bra mpopz
! 2805:
! 2806: | soustraction I-R=R sinon erreur
! 2807:
! 2808: _subirz:lea _subir,a0
! 2809: bra mpopz
! 2810:
! 2811: | soustraction R-S=R sinon erreur
! 2812:
! 2813: _subrsz:lea _subrs,a0
! 2814: bra mpopz
! 2815:
! 2816: | soustraction R-I=R sinon erreur
! 2817:
! 2818: _subriz:lea _subri,a0
! 2819: bra mpopz
! 2820:
! 2821: | soustraction R-R=R sinon erreur
! 2822:
! 2823: _subrrz:lea _subrr,a0
! 2824: bra mpopz
! 2825:
! 2826: #===================================================================#
! 2827: # #
! 2828: # Soustraction : entier court - entier court = entier #
! 2829: # #
! 2830: # entree : a7@(4) contient s2 de type S #
! 2831: # a@7(8) contient s1 de type S #
! 2832: # sortie : d0 pointe sur s2 - s1 de type I (zone creee) #
! 2833: # remarque : s2 - s1 = s0 est interdit #
! 2834: # #
! 2835: #===================================================================#
! 2836:
! 2837: _subss: link a6,#-12
! 2838: movl a6@(12),d1 | d1.l recoit s1
! 2839: negl d1 | d1.l recoit -s1
! 2840: bvs 1$
! 2841: | ici |s1| <= 2^31-1
! 2842: movl d1,sp@- | empilage -s1
! 2843: movl a6@(8),sp@- | empilage s2
! 2844: bsr _addss | calcul se s2+(-s1)
! 2845: bra subssf
! 2846: | ici s1 = -2^31
! 2847: 1$: movl #0x1000003,a6@(-12)
! 2848: movl #0x1000003,a6@(-8)
! 2849: movl #0x80000000,a6@(-4)| creation de 2^31 type entier
! 2850: pea a6@(-12) | empilage adresse de 2^31
! 2851: movl a6@(8),sp@- | empilage s2
! 2852: bsr _addsi
! 2853: subssf: unlk a6
! 2854: rts
! 2855:
! 2856: #===================================================================#
! 2857: # #
! 2858: # Soustraction : entier - entier = entier #
! 2859: # #
! 2860: # entree : a7@(4) pointe sur i2 de type I #
! 2861: # a7@(8) pointe sur i1 de type I #
! 2862: # sortie : d0 pointe sur i2 - i1 de type I (zone creee) #
! 2863: # #
! 2864: #===================================================================#
! 2865:
! 2866: _subii: link a6,#-4
! 2867: movl a6@(12),sp@- | empilage adresse i1
! 2868: movl a6@(8),sp@- | empilage adresse i2
! 2869: movl a6@(12),a0 | a0 pointe sur i1
! 2870: negb a0@(4) | changer signe de i1
! 2871: movl a0,a6@(-4)
! 2872: bsr _addii
! 2873: movl a6@(-4),a0
! 2874: negb a0@(4) | remettre signe de i1
! 2875: unlk a6
! 2876: rts
! 2877:
! 2878: #===================================================================#
! 2879: # #
! 2880: # Soustraction : reel - reel = reel #
! 2881: # #
! 2882: # entree : a7@(4) pointe sur r2 de type R #
! 2883: # a7@(8) pointe sur r1 de type R #
! 2884: # sortie : d0 pointe sur r2 - r1 de type R (zone creee) #
! 2885: # #
! 2886: #===================================================================#
! 2887:
! 2888: _subrr: link a6,#-4 | voir commentaires de _subii
! 2889: movl a6@(12),sp@-
! 2890: movl a6@(8),sp@-
! 2891: movl a6@(12),a0
! 2892: negb a0@(4)
! 2893: movl a0,a6@(-4)
! 2894: bsr _addrr
! 2895: movl a6@(-4),a0
! 2896: negb a0@(4)
! 2897: unlk a6
! 2898: rts
! 2899:
! 2900: #===================================================================#
! 2901: # #
! 2902: # Soustraction : entier court - entier = entier #
! 2903: # #
! 2904: # entree : a7@(4) contient s2 de type S #
! 2905: # a7@(8) pointe sur i1 de type I #
! 2906: # sortie : d0 pointe sur s2 - i1 de type I #
! 2907: # #
! 2908: #===================================================================#
! 2909:
! 2910: _subsi: link a6,#-4 | voir commentaires de _subii
! 2911: movl a6@(12),sp@-
! 2912: movl a6@(8),sp@-
! 2913: movl a6@(12),a0
! 2914: negb a0@(4)
! 2915: movl a0,a6@(-4)
! 2916: bsr _addsi
! 2917: movl a6@(-4),a0
! 2918: negb a0@(4)
! 2919: unlk a6
! 2920: rts
! 2921:
! 2922: #===================================================================#
! 2923: # #
! 2924: # Soustraction : entier court - reel = reel #
! 2925: # #
! 2926: # entree : a7@(4) contient s2 de type S #
! 2927: # a7@(8) pointe sur r1 de type R #
! 2928: # sortie : d0 pointe sur s2 - r1 de type R (zone creee) #
! 2929: # #
! 2930: #===================================================================#
! 2931:
! 2932: _subsr: link a6,#-4 | voir commentaires de _subii
! 2933: movl a6@(12),sp@-
! 2934: movl a6@(8),sp@-
! 2935: movl a6@(12),a0
! 2936: negb a0@(4)
! 2937: movl a0,a6@(-4)
! 2938: bsr _addsr
! 2939: movl a6@(-4),a0
! 2940: negb a0@(4)
! 2941: unlk a6
! 2942: rts
! 2943:
! 2944: #===================================================================#
! 2945: # #
! 2946: # Soustraction : entier - entier court = entier #
! 2947: # #
! 2948: # entree : a7@(4) pointe sur i1 de type I #
! 2949: # a7@(8) contient s2 de type S #
! 2950: # sortie : d0 pointe sur i1 - s2 de type I (zone creee) #
! 2951: # #
! 2952: #===================================================================#
! 2953:
! 2954: _subis: link a6,#-12 | voir commentaires de _subss
! 2955: movl a6@(8),sp@-
! 2956: movl a6@(12),d1
! 2957: negl d1
! 2958: bvs 1$
! 2959: movl d1,sp@-
! 2960: bsr _addsi
! 2961: bra subisf
! 2962: 1$: movl #0x1000003,a6@(-12)
! 2963: movl #0x1000003,a6@(-8)
! 2964: movl #0x80000000,a6@(-4)
! 2965: pea a6@(-12)
! 2966: bsr _addii
! 2967: subisf: unlk a6
! 2968: rts
! 2969:
! 2970: #===================================================================#
! 2971: # #
! 2972: # Soustraction : entier - reel = reel #
! 2973: # #
! 2974: # entree : a7@(4) pointe sur i2 de type I #
! 2975: # a7@(8) pointe sur r1 de type R #
! 2976: # sortie : d0 pointe sur i2 - r1 de type R (zone creee) #
! 2977: # #
! 2978: #===================================================================#
! 2979:
! 2980: _subir: link a6,#-4 | voir commentaires de _subii
! 2981: movl a6@(12),sp@-
! 2982: movl a6@(8),sp@-
! 2983: movl a6@(12),a0
! 2984: negb a0@(4)
! 2985: movl a0,a6@(-4)
! 2986: bsr _addir
! 2987: movl a6@(-4),a0
! 2988: negb a0@(4)
! 2989: unlk a6
! 2990: rts
! 2991:
! 2992: #===================================================================#
! 2993: # #
! 2994: # Soustraction : reel - entier = reel #
! 2995: # #
! 2996: # entree : a7@(4) pointe sur r1 de type R #
! 2997: # a7@(8) pointe sur i2 de type I #
! 2998: # sortie : d0 pointe sur r2 - i1 de type R (zone creee) #
! 2999: # #
! 3000: #===================================================================#
! 3001:
! 3002: _subri: link a6,#-4 | voir commentaires de _subii
! 3003: movl a6@(8),sp@-
! 3004: movl a6@(12),sp@-
! 3005: movl a6@(12),a0
! 3006: negb a0@(4)
! 3007: movl a0,a6@(-4)
! 3008: bsr _addir
! 3009: movl a6@(-4),a0
! 3010: negb a0@(4)
! 3011: unlk a6
! 3012: rts
! 3013:
! 3014: #===================================================================#
! 3015: # #
! 3016: # Soustraction : reel - entier court = reel #
! 3017: # #
! 3018: # entree : a7@(4) pointe sur r2 de type R #
! 3019: # a7@(8) contient s1 de type S #
! 3020: # sortie : d0 pointe sur r2 - s1 de type R (zone creee) #
! 3021: # #
! 3022: #===================================================================#
! 3023:
! 3024: _subrs: link a6,#-12 | voir commentaires de _subss
! 3025: movl a6@(8),sp@-
! 3026: movl a6@(12),d1
! 3027: negl d1
! 3028: bvs 1$
! 3029: movl d1,sp@-
! 3030: bsr _addsr
! 3031: bra subsrf
! 3032: 1$: movl #0x1000003,a6@(-12)
! 3033: movl #0x1000003,a6@(-8)
! 3034: movl #0x80000000,a6@(-4)
! 3035: pea a6@(-12)
! 3036: bsr _addir
! 3037: subsrf: unlk a6
! 3038: rts
! 3039:
! 3040:
! 3041:
! 3042:
! 3043:
! 3044: #*******************************************************************#
! 3045: #*******************************************************************#
! 3046: #** **#
! 3047: #** PROGRAMMES DE MULTIPLICATION **#
! 3048: #** **#
! 3049: #*******************************************************************#
! 3050: #*******************************************************************#
! 3051:
! 3052:
! 3053:
! 3054:
! 3055:
! 3056: #===================================================================#
! 3057: # #
! 3058: # Multiplication generale #
! 3059: # #
! 3060: # entree : a7@(4) pointe sur n2 de type I ou R #
! 3061: # a7@(8) pointe sur n1 de type I ou R #
! 3062: # sortie : d0 pointe sur n2 * n1 de type I ou R (zone cree) #
! 3063: # interdit : type S #
! 3064: # precision : voir routines specialisees #
! 3065: # #
! 3066: #===================================================================#
! 3067:
! 3068: _mpmul: movl sp@(4),a0
! 3069: movl sp@(8),a1 | a1 et a0 pointent sur n1 et n2
! 3070: movb a0@,d0
! 3071: movb a1@,d1 | d1.b et d0.b contiennent T1 et T2
! 3072: cmpb d1,d0
! 3073: ble 1$
! 3074: | ici T2 > T1
! 3075: exg a1,a0
! 3076: exg d1,d0
! 3077: movl a0,sp@(4)
! 3078: movl a1,sp@(8)
! 3079: | ici T2 <= T1
! 3080: 1$: cmpb #1,d1
! 3081: beq _asmmulii | ici T1 = T2 = I
! 3082: 2$: cmpb #2,d0
! 3083: beq _mulrr | ici T1 = T2 = R
! 3084: bra _mulir
! 3085:
! 3086: #===================================================================#
! 3087: # #
! 3088: # Multiplication (par valeur) #
! 3089: # #
! 3090: # entree : a7@(4) pointe sur n2 de type I ou R #
! 3091: # a7@(8) pointe sur n1 de type I ou R #
! 3092: # a7@(12) pointe sur n3 de type I ou R #
! 3093: # sortie : la zone pointee par a7@(12) contient n2*n1 #
! 3094: # interdit : type S #
! 3095: # #
! 3096: #===================================================================#
! 3097:
! 3098: _mpmulz:lea _mpmul,a0
! 3099: bra mpopz
! 3100:
! 3101: | multiplication S*S=I ou R
! 3102:
! 3103: _mulssz:lea _mulss,a0
! 3104: bra mpopz
! 3105:
! 3106: | multiplication S*I=I ou R
! 3107:
! 3108: _mulsiz:lea _mulsi,a0
! 3109: bra mpopz
! 3110:
! 3111: | multiplication S*R=R sinon erreur
! 3112:
! 3113: _mulsrz:lea _mulsr,a0
! 3114: bra mpopz
! 3115:
! 3116: | multiplication I*I=I ou R
! 3117:
! 3118: _muliiz:lea _asmmulii,a0
! 3119: bra mpopz
! 3120:
! 3121: | multiplication I*R=R sinon erreur
! 3122:
! 3123: _mulirz:lea _mulir,a0
! 3124: bra mpopz
! 3125:
! 3126: | multiplication R*R=R sinon erreur
! 3127:
! 3128: _mulrrz:lea _mulrr,a0
! 3129: bra mpopz
! 3130:
! 3131: #===================================================================#
! 3132: # #
! 3133: # Multiplication : entier court * entier court = entier #
! 3134: # #
! 3135: # entree : a7@(4) contient s2 de type S #
! 3136: # a7@(8) contient s1 de type S #
! 3137: # sortie : d0 pointe sur s2 * s1 de type I (zone creee) #
! 3138: # #
! 3139: #===================================================================#
! 3140:
! 3141: _mulss: link a6,#-2
! 3142: moveml d2-d4,sp@-
! 3143: movl a6@(8),d2 | d2.l contient s2
! 3144: bne 1$
! 3145: 2$: movl _gzero,d0 | ici s2 ou s1 = 0
! 3146: bra mulssg
! 3147: | ici s2 <> 0
! 3148: 1$: movl d2,d4
! 3149: bpl 3$
! 3150: negl d2 | d2.l contient |s2|
! 3151: 3$: movl a6@(12),d1 | d1.l contient s1
! 3152: beq 2$ | si s1=0
! 3153: eorl d1,d4
! 3154: tstl d1
! 3155: bpl 4$
! 3156: negl d1 | d1.l contient |s1|
! 3157: 4$: mulul d1,d3:d2
! 3158: movw #4,d0
! 3159: tstl d3
! 3160: bne 5$
! 3161: movw #3,d0 | d0 recoit 3 ou 4 pour allocation
! 3162: 5$: bsr geti
! 3163: movw a0@(2),a0@(6) | met long effect.
! 3164: movb #1,a0@(4) | met signe
! 3165: tstl d4
! 3166: bpl 6$
! 3167: negb a0@(4)
! 3168: 6$: tstl d3
! 3169: bne 7$
! 3170: movl d2,a0@(8)
! 3171: bra mulssf
! 3172: 7$: movl d3,a0@(8)
! 3173: movl d2,a0@(12)
! 3174: mulssf: movl a0,d0
! 3175: mulssg: moveml sp@+,d2-d4
! 3176: unlk a6
! 3177: rts
! 3178:
! 3179: #===================================================================#
! 3180: # #
! 3181: # Multiplication : entier court * entier = entier #
! 3182: # #
! 3183: # entree : a7@(4) contient s2 de type S #
! 3184: # a7@(8) pointe sur i1 de type I #
! 3185: # sortie : d0 pointe sur s2 * i1 de type I (zone creee) #
! 3186: # #
! 3187: #===================================================================#
! 3188:
! 3189: _mulsi: link a6,#0
! 3190: moveml d2-d6/a2,sp@-
! 3191: movl a6@(8),d2 | d2.l contient s2
! 3192: bne 1$
! 3193: | ici s2 = 0 ou i1 = 0
! 3194: 2$: movl _gzero,d0
! 3195: bra mulsig
! 3196: | ici s2 <> 0
! 3197: 1$: bpl 6$
! 3198: negl d2 | d2 contient |s2|
! 3199: 6$: movl a6@(12),a1 | a1 pointe sur i1
! 3200: tstb a1@(4)
! 3201: beq 2$ | si i1 = 0
! 3202: | ici i1 <> 0 et s2 <> 0
! 3203: movw a1@(6),d0 | d0.w contient le1
! 3204: bsr geti
! 3205: lea a0@(0,d0:w:4),a2| a2 pointe apres resultat (i0)
! 3206: lea a1@(0,d0:w:4),a1| a1 pointe apres i1
! 3207: subqw #3,d0
! 3208: moveq #0,d6
! 3209: moveq #0,d5 | initialisation retenue
! 3210: | debut boucle multiplication
! 3211: 3$: movl a1@-,d4
! 3212: mulul d2,d3:d4
! 3213: addl d5,d4
! 3214: addxl d6,d3
! 3215: movl d4,a2@-
! 3216: movl d3,d5
! 3217: dbra d0,3$
! 3218: beq 5$
! 3219: | ici retenue finale
! 3220: movw #1,d0
! 3221: bsr geti
! 3222: movw a0@(6),d0
! 3223: addqw #1,d0 | d0.w contient le(i0)
! 3224: bvc 4$
! 3225: | ici debordement
! 3226: movl #muler3,sp@-
! 3227: jsr _pari_err
! 3228: 4$: movw d0,a0@(2) | mise longueur
! 3229: movl d5,a0@(8) | mise retenue
! 3230: 5$: movw a0@(2),a0@(6) | mise le(i0)
! 3231: movb a1@(-4),a0@(4)
! 3232: tstl a6@(8)
! 3233: bpl mulsif
! 3234: negb a0@(4) | mise signe
! 3235: mulsif: movl a0,d0
! 3236: mulsig: moveml sp@+,d2-d6/a2
! 3237: unlk a6
! 3238: rts
! 3239:
! 3240: #===================================================================#
! 3241: # #
! 3242: # Multiplication : entier court * reel = reel #
! 3243: # #
! 3244: # entree : a7@(4) contient s2 de type S #
! 3245: # a7@(8) pointe sur r1 de type R #
! 3246: # sortie : d0 pointe sur s2 * r1 de type R #
! 3247: # de longueur L = L1 (zone creee) #
! 3248: # #
! 3249: #===================================================================#
! 3250:
! 3251: _mulsr: link a6,#-4
! 3252: moveml d2-d6/a2,sp@-
! 3253: movl a6@(8),d2 | d2.l contient s2
! 3254: bne 1$
! 3255: | ici s2 = 0
! 3256: movl _gzero,d0
! 3257: bra mulsrf1
! 3258: | ici s2 <> 0
! 3259: 1$: movl a6@(12),a1 | a1 pointe sur r1
! 3260: tstb a1@(4)
! 3261: bne 2$
! 3262: | ici r1 = 0
! 3263: moveq #3,d0
! 3264: bsr getr
! 3265: tstl d2
! 3266: bpl 2$
! 3267: negl d2
! 3268: bfffo d2{#0:#0},d0
! 3269: movl a1@(4),d1
! 3270: addl #31,d1
! 3271: subl d0,d1
! 3272: cmpl #0x1000000,d1
! 3273: bcc 11$
! 3274: movl d1,a0@(4)
! 3275: clrl a0@(8)
! 3276: movl a0,d0
! 3277: bra mulsrf1
! 3278: 2$: movw a1@(2),d0
! 3279: bsr getr | allocation memoire pour resultat
! 3280: movl a0,a6@(-4) | sauvegarde adr. resultat ds var.locale
! 3281: | ici s2 et r1 <> 0
! 3282: movl d2,d4
! 3283: bpl 3$
! 3284: negl d2 | d2.l contient |s2|
! 3285: 3$: cmpl #1,d2
! 3286: bne 4$
! 3287: | ici |s2| = 1
! 3288: addql #4,a0
! 3289: addql #4,a1
! 3290: subqw #2,d0
! 3291: 5$: movl a1@+,a0@+
! 3292: dbra d0,5$ | copie de r1 dans resultat
! 3293: movl a6@(-4),a0
! 3294: tstl d4
! 3295: bpl mulsrf
! 3296: negb a0@(4) | mise signe
! 3297: bra mulsrf
! 3298: | ici |s2| <> 1 et 0 , r1 <> 0
! 3299: 4$: movb a1@(4),a0@(4)
! 3300: tstl d4
! 3301: bpl 6$
! 3302: negb a0@(4) | mise signe
! 3303: 6$: lea a0@(0,d0:w:4),a0| a0 pointe apres resultat
! 3304: lea a1@(0,d0:w:4),a1| a1 pointe apres r1
! 3305: subqw #3,d0 | d0.w contient L1-1
! 3306: movw d0,d4 | d4.w idem
! 3307: movw d4,d6
! 3308: moveq #0,d1 | d1 a 0 pour les addx
! 3309: moveq #0,d0 | initialisation retenue d0
! 3310: | boucle de multiplication :
! 3311: 7$: movl a1@-,d5
! 3312: mulul d2,d3:d5
! 3313: addl d0,d5
! 3314: addxl d1,d3
! 3315: movl d5,a0@-
! 3316: movl d3,d0 | nouvelle retenue d0
! 3317: dbra d6,7$
! 3318: bfffo d0{#0:#0},d1 | d1.l contient nb. de shifts
! 3319: lsll d1,d0 | normalisation de d0
! 3320: moveq #1,d6
! 3321: lsll d1,d6
! 3322: subql #1,d6 | masque de shift
! 3323: negb d1
! 3324: addb #32,d1
! 3325: | boucle de shift
! 3326: 8$: movl a0@,d2
! 3327: rorl d1,d2
! 3328: movl d2,d3
! 3329: andl d6,d3
! 3330: subl d3,d2
! 3331: addl d3,d0
! 3332: movl d0,a0@+
! 3333: movl d2,d0
! 3334: dbra d4,8$
! 3335: movl a6@(-4),a0 | a0 pointe sur resultat
! 3336: movl a1@(-4),d0
! 3337: andl #0xffffff,d0 | d0.l contient fexp1
! 3338: addl d1,d0 | d0.l contient fexp resultat
! 3339: btst #24,d0
! 3340: beq 9$
! 3341: | ici debordement
! 3342: 11$: movl #muler2,sp@-
! 3343: jsr _pari_err
! 3344: 9$: movw d0,a0@(6) | mise exposant
! 3345: swap d0
! 3346: movb d0,a0@(5)
! 3347: mulsrf: movl a6@(-4),d0 | adresse du resultat
! 3348: mulsrf1:moveml sp@+,d2-d6/a2
! 3349: unlk a6
! 3350: rts
! 3351:
! 3352: #===================================================================#
! 3353: # #
! 3354: # Multiplication : entier * entier = entier #
! 3355: # #
! 3356: # entree : a7@(4) pointe sur i2 de type I #
! 3357: # a7@(8) pointe sur i1 de type I #
! 3358: # sortie : d0 pointe sur i2 * i1 de type I (zone creee) #
! 3359: # #
! 3360: #===================================================================#
! 3361:
! 3362: _asmmulii: link a6,#0
! 3363: moveml d2-d7/a2-a4,sp@-
! 3364: movl a6@(8),a1
! 3365: movl a6@(12),a2 | a1,a2 pointent sur i1,i2
! 3366: movw a1@(6),d1
! 3367: movw a2@(6),d2 | d1.w, d2.w contient l1,l2
! 3368: cmpw d1,d2
! 3369: bcc 1$
! 3370: | ici l1>l2 : echanger i1 et i2
! 3371: exg a1,a2
! 3372: exg d1,d2 | maintenant l1<=l2
! 3373: 1$: subqw #2,d1 | d1 recoit L1
! 3374: bne 2$
! 3375: | ici L1=0 <==> i1*i2 = 0
! 3376: 6$: movl _gzero,d0 | cree resultat nul de type I
! 3377: bra muliig
! 3378: | maintenant 1<=L1<=L2
! 3379: 2$: movw d2,d0 | d0 recoit l2
! 3380: addw d1,d0 | d0 recoit l2 + L1 = L1 + L2 + 2
! 3381: bvc 3$
! 3382: movl #muler1,sp@-
! 3383: jsr _pari_err | debordement
! 3384: bra 6$
! 3385: 3$: bsr geti | allocation memoire pour resultat
! 3386: movw d0,a0@(6) | met long effect. (peut-etre 1 de trop)
! 3387: movb a1@(4),d3
! 3388: movb a2@(4),d4
! 3389: eorb d4,d3
! 3390: addqb #1,d3
! 3391: movb d3,a0@(4) | met signe du resultat
! 3392: lea a0@(0,d0:w:4),a4| a4 pointe apres fin resultat = z
! 3393: lea a1@(8,d1:w:4),a1| a1 pointe apres fin de i1 = y
! 3394: lea a2@(0,d2:w:4),a3| a3 pointe apres fin de i2 = x
! 3395: subqw #1,d1 | d1 recoit L1-1 compt bcl externe
! 3396: subqw #3,d2 | d2 recoit L2-1 compt bcl interne
! 3397: movw d2,d0 | sauvegarde compt interne dans d0
! 3398: moveq #0,d7 | registre d7 fixe a 0
! 3399: | Boucles de multiplication I*I :
! 3400: | x=x1x2...xn multiplicande (x=i2,n=L2) pointe par a2 et a3
! 3401: | y=y1...ym multiplicateur (y=i1,m=L1) pointe par a1
! 3402: | z=z1z2...z(n+m) resultat pointe par a0 et a4
! 3403: | a0 et a2 sont decrementes par la boucle interne (les valeurs initiales
! 3404: | etant conservees dans a4 et a3)
! 3405: #...................................................................#
! 3406: | 1re boucle interne:initialise resultat
! 3407: | (z recoit x*ym)
! 3408: movl a3,a2 | a2 pointe apres xn
! 3409: movl a4,a0 | a0 pointe apres z(n+m)
! 3410: movl a1@-,d3 | d3 recoit ym
! 3411: subl d4,d4 | d4 retenue k et X initialise a 0
! 3412: m1: movl d4,d6 | nouvelle retenue dans d6
! 3413: movl d3,d5 | dupliquer le multiplicateur
! 3414: mulul a2@-,d4:d5 | d4:d5 recoit xi*ym (i=n,n-1,...,1)
! 3415: addxl d5,d6
! 3416: addxl d7,d4 | d4:d5 recoit xi*ym + k
! 3417: movl d6,a0@- | range z(i+m)
! 3418: dbra d2,m1 | fin 1re bcl interne
! 3419: bra bclf | brancher fin de boucle externe
! 3420: mext: subql #4,a4 | a4 pointe apres z(n+i)
! 3421: movl a3,a2 | a2 pointe apres xn
! 3422: movl a4,a0 | a0 pointe apres z(n+i)
! 3423: movl d0,d2 | d2 recoit n-1 compteur bcl interne
! 3424: movl a1@-,d3 | d3 recoit yj (j=m-1,m-2...1)
! 3425: subl d4,d4 | d4 retenue k et X initialise a 0
! 3426: mint: movl d4,d6 | nouvelle retenue dans d6
! 3427: movl d3,d5 | dupliquer le multiplicateur
! 3428: mulul a2@-,d4:d5 | d4:d5 recoit xi*yj (i=n,n-1,...,1)
! 3429: addxl d5,d6
! 3430: addxl d7,d4 | d4:d5 recoit xi*yj + k
! 3431: addl d6,a0@- | range partie basse de xi*yj+z(i+j)+k
! 3432: dbra d2,mint | fin de boucle interne
! 3433: addxl d7,d4
! 3434: bclf: movl d4,a0@- | range derniere retenue
! 3435: dbra d1,mext | fin bcl externe
! 3436: #...................................................................#
! 3437: | derniere retenue = 0 ?
! 3438: beq 4$
! 3439: subql #8,a0 | non : rien a faire
! 3440: | a0 pointe sur resultat
! 3441: bra muliif
! 3442: | ici pas de retenue finale
! 3443: 4$: subqw #1,a0@(-2)
! 3444: subqw #1,a0@(-6) | rectifier longueurs
! 3445: movl a0@(-4),a0@ | deplacer mots codes
! 3446: movl a0@(-8),a0@- | a0 pointe sur resultat
! 3447: addl #4,_avma
! 3448: muliif: movl a0,d0
! 3449: muliig: moveml sp@+,d2-d7/a2-a4
! 3450: unlk a6
! 3451: rts
! 3452:
! 3453: #===================================================================#
! 3454: # #
! 3455: # Multiplication : reel * reel = reel #
! 3456: # #
! 3457: # entree : a7@(4) pointe sur r2 de type R #
! 3458: # a7@(8) pointe sur r1 de type R #
! 3459: # sortie : d0 pointe sur r2 * r1 de type R (zone creee) #
! 3460: # #
! 3461: # precision : L = inf ( L1 , L2 ) #
! 3462: # #
! 3463: #===================================================================#
! 3464:
! 3465: _mulrr: link a6,#-20 | variables locales pour murr aussi
! 3466: moveml d2-d7/a2-a4,sp@-
! 3467: movl a6@(8),a1 | a1 pointe sur r1
! 3468: movl a6@(12),a2 | a2 pointe sur r2
! 3469: movb a1@(4),d0
! 3470: andb a2@(4),d0
! 3471: bne munzr
! 3472: | ici r1 ou r2 = 0
! 3473: muzr: moveq #3,d0
! 3474: bsr getr
! 3475: movl a0,a6@(-8)
! 3476: movl a1@(4),d1
! 3477: andl #0xffffff,d1 | exposant de x1
! 3478: movl a2@(4),d2
! 3479: andl #0xffffff,d2 | exposant de y
! 3480: addl d2,d1
! 3481: subl #0x800000,d1
! 3482: cmpl #0x1000000,d1
! 3483: bcs 1$
! 3484: movl #muler4,sp@- | debordement r*r
! 3485: jsr _pari_err
! 3486: 1$: tstl d1
! 3487: bgt 2$
! 3488: movl #muler5,sp@- | underflow r*r
! 3489: jsr _pari_err
! 3490: 2$: movl d1,a0@(4)
! 3491: clrl a0@(8)
! 3492: bra mulrrf
! 3493:
! 3494: munzr: movw a2@(2),d0
! 3495: clrl a6@(-12) | Initialiser flag a 0
! 3496: cmpw a1@(2),d0
! 3497: bls 1$
! 3498: movw a1@(2),d0 | d0.w contient L+2=inf(L1,L2)+2
! 3499: exg a1,a2 | a2 pointe sur le + court
! 3500: bra 2$
! 3501: 1$: bne 2$
! 3502: lea a1@(0,d0:w:4),a3 | a3 pointe sur x[L+1]
! 3503: movl a3,a6@(-12) | longueurs egales: flag egal adresse
! 3504: movl a3@,a6@(-16) | sauvegarde de x[L+1]
! 3505: clrl a3@
! 3506: 2$: bsr getr
! 3507: movl a0,a6@(-8)
! 3508: bsr murr | effectuer la multiplication
! 3509: tstl a6@(-12)
! 3510: beq mulrrf
! 3511: movl a6@(-12),a3
! 3512: movl a6@(-16),a3@ | remettre x[L+1]
! 3513: mulrrf: movl a6@(-8),d0 | adresse du resultat
! 3514: moveml sp@+,d2-d7/a2-a4
! 3515: unlk a6
! 3516: rts
! 3517:
! 3518: #-------------------------------------------------------------------#
! 3519: # module interne de multiplication r0=r1*r2 #
! 3520: # ( pour R*R et I*R) #
! 3521: # entree : a1 et a2 pointent sur 2 reels #
! 3522: # r1,r2 non nuls avec L1>=L2=m #
! 3523: # a0 pointe sur une zone reelle de long l1 #
! 3524: # sortie : le produit r0 est mis a l'addresse a0 #
! 3525: # #
! 3526: #-------------------------------------------------------------------#
! 3527:
! 3528: | notation : r1 = x = x1x2...xmx(m+1)... multiplicande
! 3529: | r2 = y = y1y2...ym multiplicateur
! 3530: | ( le lgmot x(m+1) peut ne pas exister ! ( le1 >= le2 = m ) )
! 3531: | z = z0z1z2...zmz(m+1) resultat.
! 3532: | ( z0=0 ou 1 et z(m+1) a jeter)
! 3533:
! 3534: murr: movl a1,a3
! 3535: lea a3@(12),a3 | a3 pointe sur x2 (2me lgmot mant.x)
! 3536: # movw a2@(2),d0 | d0.w=L2=m long commune des mantisses (mis a l'appel!)
! 3537: lea a2@(0,d0:w:4),a2| a2 pointe apres ym
! 3538: lea a0@(0,d0:w:4),a0| a0 pointe apres zm
! 3539: movl a0@,a6@(-4) | on sauvegarde le lg mot suivant z
! 3540: clrl a0@+ | z(m+1) recoit 0,a0 pointe apres z(m+1)
! 3541: subqw #3,d0 | d0 recoit m-1
! 3542: movl d0,a6@(-20) | sauvegarde m-1 compt. bcl externe
! 3543: clrw d3 | d3=0,val initiale compt bcl interne
! 3544: | Boucles triangulaires mult. R*R
! 3545: #...................................................................#
! 3546: bext: movl a0,a4 | a4 pointe apres z(m+1)
! 3547: movl a3,a1 | a1 pointe sur x(j+1) (j=1,2...m)
! 3548: movw d3,d2 | d3 recoit m-j compt bcl interne
! 3549: movl a2@-,d4 | d4 recoit yj
! 3550: movl a3@+,d5 | d5 recoit x(j+1)
! 3551: subl d1,d1 | d1 a zero ainsi que bit X
! 3552: mulul d4,d7:d5 | init.retenue d7(ignorer poids faible)
! 3553: bint: movl d7,d6 | sauvegarder nouvelle retenue
! 3554: movl d4,d5 | dupliquer multiplicateur
! 3555: mulul a1@-,d7:d5 | d7:d5 recoit xi*yj
! 3556: addxl d5,d6
! 3557: addxl d1,d7 | d7:d5 recoit xi*yj + k
! 3558: addl d6,a4@- | nouveau z(i+j)
! 3559: dbra d2,bint
! 3560: addxl d1,d7
! 3561: movl d7,a4@- | range derniere retenue
! 3562: addqw #1,d3 | augmente de 1 long bcl interne
! 3563: dbra d0,bext | fin bcl externe
! 3564: #...................................................................#
! 3565: movl a1@(-4),d1 | a1 pointe sur x1 (1er mot mant de x)
! 3566: andl #0xffffff,d1 | exposant de x1
! 3567: movl a2@(-4),d2 | a2 pointe sur y1
! 3568: andl #0xffffff,d2 | exposant de y
! 3569: addl d2,d1
! 3570: subl #0x800000,d1
! 3571: tstl a4@ | a4 pointe sur z1 : z normalise ?
! 3572: bpl 1$
! 3573: addl #1,d1 | ici mantisse normalisee
! 3574: bra 2$
! 3575: | ici il faut shifter de 1 a gauche
! 3576: 1$: movl a0,a4 | a4 pointe apres z(m+1)
! 3577: subqw #2,a4
! 3578: movl a6@(-20),d0 | recuperer m-1
! 3579: roxlw a4@- | initialise le carry
! 3580: 5$: roxlw a4@- | shift par mots (d0 compteur=m-1)
! 3581: roxlw a4@-
! 3582: dbra d0,5$ | boucle de shift
! 3583: 2$: cmpl #0x1000000,d1
! 3584: bcs 3$
! 3585: movl #muler4,sp@- | debordement r*r
! 3586: jsr _pari_err
! 3587: 3$: tstl d1
! 3588: bgt 4$
! 3589: movl #muler5,sp@- | underflow r*r
! 3590: jsr _pari_err
! 3591: 4$: movl d1,a4@- | range exposant
! 3592: movb a1@(-4),d1
! 3593: movb a2@(-4),d2 | signes
! 3594: eorb d2,d1
! 3595: addqb #1,d1
! 3596: movb d1,a4@ | range signe resultat
! 3597: movl a6@(-4),a0@(-4) | remet en place mot sous z(m+1)
! 3598: murrf: rts
! 3599:
! 3600: #===================================================================#
! 3601: # #
! 3602: # Multiplication : entier * reel = reel #
! 3603: # #
! 3604: # entree : a7@(4) pointe sur i2 de type I #
! 3605: # a7@(8) pointe sur r1 de type R #
! 3606: # sortie : d0 pointeur sur i2 * r1 de type R (zone creee) #
! 3607: # #
! 3608: #===================================================================#
! 3609:
! 3610: _mulir: link a6,#-20
! 3611: moveml d2-d7/a2-a4,sp@-
! 3612: movl a6@(8),a2 | a2 pointe sur i2
! 3613: tstb a2@(4)
! 3614: bne 1$
! 3615: | ici i2 = 0
! 3616: movl _gzero,d0
! 3617: bra mulirf1
! 3618: | ici i2 <> 0
! 3619: 1$: movl a6@(12),a1 | a1 pointe sur r1
! 3620: tstb a1@(4)
! 3621: bne 2$
! 3622: | ici r1 = 0
! 3623: moveq #3,d0
! 3624: bsr getr
! 3625: movw a2@(6),d0
! 3626: lsll #5,d0
! 3627: bfffo a2@(8){#0:#0},d1
! 3628: subl d1,d0
! 3629: subl #65,d0
! 3630: addl a1@(4),d0
! 3631: cmpl #0x1000000,d0
! 3632: bcs 3$
! 3633: movl #muler6,sp@- | overflow I*R, R = 0
! 3634: jsr _pari_err
! 3635: 3$: movl d0,a0@(4)
! 3636: clrl a0@(8)
! 3637: movl a0,d0
! 3638: bra mulirf1
! 3639: | ici i2 <> 0 et r1<> 0
! 3640: 2$: movw a1@(2),d0
! 3641: bsr getr | allocation memoire pour resultat
! 3642: movl a0,a6@(-8) | sauvegarde adresse resultat
! 3643: addqw #1,d0
! 3644: bsr getr | allocation mem pour conversion i2->r2
! 3645: movl a0,a7@-
! 3646: movl a2,a7@-
! 3647: bsr _affir
! 3648: addql #4,sp
! 3649: movl a7@,a2 | a2 recoit adr de r2=i2 (reste en pile)
! 3650: movl a6@(-8),a0 | a0 recoit addresse du resultat
! 3651: exg a1,a2 | Il faut que a2 soit le plus court!
! 3652: movw a2@(2),d0 | Mettre la plus petite longueur dans d0 pour murr
! 3653: bsr murr
! 3654: movl a7@+,a0
! 3655: bsr giv
! 3656: mulirf: movl a6@(-8),d0
! 3657: mulirf1:moveml sp@+,d2-d7/a2-a4
! 3658: unlk a6
! 3659: rts
! 3660:
! 3661:
! 3662:
! 3663:
! 3664:
! 3665: #*******************************************************************#
! 3666: #*******************************************************************#
! 3667: #** **#
! 3668: #** PROGRAMMES DE DIVISION AVEC RESTE **#
! 3669: #** **#
! 3670: #*******************************************************************#
! 3671: #*******************************************************************#
! 3672:
! 3673:
! 3674:
! 3675:
! 3676:
! 3677: #===================================================================#
! 3678: # #
! 3679: # Division avec reste (par valeur) #
! 3680: # #
! 3681: # entree : a7@(4) pointe sur n2 de type I #
! 3682: # a7@(8) pointe sur n1 de type I #
! 3683: # a7@(12) pointe sur n3 de type I #
! 3684: # a7@(16) pointe sur n4 de type I #
! 3685: # sortie : la zone pointee par a7@(12) contient n2 / n1 #
! 3686: # la zone pointee par a7@(16) contient le reste (du #
! 3687: # signe du dividende) #
! 3688: # interdit : type S et R #
! 3689: # #
! 3690: #===================================================================#
! 3691:
! 3692: _mpdvmdz:lea _asmdvmdii,a0
! 3693: bra mpopii
! 3694:
! 3695: | division avec reste S/S=(I et I)
! 3696: | sinon erreur
! 3697:
! 3698: _dvmdssz:lea _dvmdss,a0
! 3699: bra mpopii
! 3700:
! 3701: | division avec reste S/I=(I et I)
! 3702: | sinon erreur
! 3703:
! 3704: _dvmdsiz:lea _dvmdsi,a0
! 3705: bra mpopii
! 3706:
! 3707: | division avec reste I/S=(I et I)
! 3708: | sinon erreur
! 3709:
! 3710: _dvmdisz:lea _dvmdis,a0
! 3711: bra mpopii
! 3712:
! 3713: | division avec reste I/I=(I et I)
! 3714: | sinon erreur
! 3715:
! 3716: _dvmdiiz:lea _asmdvmdii,a0
! 3717: bra mpopii
! 3718:
! 3719: #===================================================================#
! 3720: # #
! 3721: #Division avec reste : entier court / entier court =(entier,entier) #
! 3722: # #
! 3723: # entree : a7@(4) contient s2 de type S #
! 3724: # a7@(8) contient s1 de type S #
! 3725: # sortie : a7@(12) pointe sur l'adresse du futur reste #
! 3726: # d0 pointe sur s2 div s1 de type I #
! 3727: # le reste est du signe de s2 (zone creee) #
! 3728: # #
! 3729: #===================================================================#
! 3730:
! 3731: _dvmdss:link a6,#0
! 3732: movl d2,sp@-
! 3733: movl a6@(12),sp@- | empilage s1
! 3734: movl a6@(8),sp@- | empilage s2
! 3735: bsr _divss
! 3736: dmd: addql #8,sp
! 3737: tstl d1
! 3738: bne 1$
! 3739: | ici reste nul
! 3740: movl _gzero,a0
! 3741: bra dvmdssf
! 3742: | ici reste non nul
! 3743: 1$: movl d0,d2
! 3744: moveq #3,d0
! 3745: bsr geti
! 3746: movl #0x1000003,a0@(4)
! 3747: tstl d1
! 3748: bpl 2$
! 3749: negl d1
! 3750: movb #-1,a0@(4)
! 3751: 2$: movl d1,a0@(8)
! 3752: movl d2,d0
! 3753: dvmdssf:movl a6@(16),a1
! 3754: movl a0,a1@
! 3755: movl sp@,d2
! 3756: unlk a6
! 3757: rts
! 3758:
! 3759: #===================================================================#
! 3760: # #
! 3761: # Division avec reste : entier court / entier = (entier,entier) #
! 3762: # #
! 3763: # entree : a7@(4) contient s2 de type S #
! 3764: # a7@(8) pointe sur i1 de type I #
! 3765: # a7@(12) pointe sur l'adresse du futur reste #
! 3766: # sortie : d0 pointe sur s2 div i1 de type I ; #
! 3767: # reste du signe de s2 (zones creees) #
! 3768: # #
! 3769: #===================================================================#
! 3770:
! 3771: _dvmdsi:movl a7@(8),sp@-
! 3772: movl a7@(8),sp@-
! 3773: bsr _divsi
! 3774: dmdi: addql #8,sp
! 3775: tstl d1
! 3776: bne 1$
! 3777: | ici reste nul
! 3778: movl _gzero,sp@(12)@
! 3779: rts
! 3780: | ici reste non nul
! 3781: 1$: movl d0,a1 | sauvegarde adresse quotient
! 3782: moveq #3,d0
! 3783: bsr geti
! 3784: movl #0x1000003,a0@(4)
! 3785: tstl d1
! 3786: bpl 2$
! 3787: negl d1
! 3788: movb #-1,a0@(4)
! 3789: 2$: movl d1,a0@(8)
! 3790: 3$: movl a1,d0
! 3791: movl a0,sp@(12)@
! 3792: rts
! 3793:
! 3794: #===================================================================#
! 3795: # #
! 3796: # Division avec reste : entier / entier court = (entier,entier) #
! 3797: # #
! 3798: # entree : a7@(4) pointe sur i2 de type I #
! 3799: # a7@(8) contient s1 de type S #
! 3800: # a7@(12) pointe sur l'adresse du futur reste #
! 3801: # sortie : d0 pointe sur i2 div s1 de type I #
! 3802: # reste de type I du signe de s1 (zones creees) #
! 3803: # #
! 3804: #===================================================================#
! 3805:
! 3806: _dvmdis:movl a7@(8),sp@-
! 3807: movl a7@(8),sp@-
! 3808: bsr _divis
! 3809: bra dmdi
! 3810:
! 3811: #===================================================================#
! 3812: # #
! 3813: # Division avec reste : entier / entier = (entier,entier) #
! 3814: # #
! 3815: # entree : a7@(4) pointe sur i2 de type I (dividende) #
! 3816: # a7@(8) pointe sur i1 de type I (diviseur) #
! 3817: # a7@(12) contient un pointeur sur le reste si l'on #
! 3818: # veut a la fois q et r, 0 si l'on ne veut que le #
! 3819: # quotient, -1 si l'on ne veut que le reste #
! 3820: # sortie : d0 pointe sur q si celui-ci est attendu, et sinon #
! 3821: # sur r. a7@(12) pointe sur r si q et r sont attendus#
! 3822: # (toutes les zones sont creees) #
! 3823: # remarque : il s'agit de la 'fausse division' ; le reste est #
! 3824: # du signe du dividende #
! 3825: # #
! 3826: # #
! 3827: # variables locales (etat pile apres link): #
! 3828: # -16 -14 -12 -10 -8 -6 -4 a6 4 8 12 16 #
! 3829: # +---+---+---+---+---+---+------+----+----+----+----+----+ #
! 3830: # n-m k sgnq sgnr n m ad(q,r) ret i2 i1 ^r/0/-1 #
! 3831: # #
! 3832: #===================================================================#
! 3833:
! 3834: _asmdvmdii:link a6,#-32
! 3835: moveml d2-d7/a2-a4,sp@-
! 3836: movl a6@(12),a1 | a1 pointe sur le diviseur i1
! 3837: movw a1@(6),d1 | d1.w contient le1
! 3838: cmpw #2,d1
! 3839: bne dv1
! 3840: | ici i1 = 0
! 3841: movl #dvmer1,sp@-
! 3842: dvmerr: jsr _pari_err
! 3843: | ici i1 <> 0
! 3844: dv1: movl a6@(8),a2 | a2 pointe sur dividende i2
! 3845: movw a2@(6),d2 | d2.w contient le2
! 3846: cmpw #2,d2
! 3847: bne dv3
! 3848: | ici quotient=reste=0
! 3849: dv2: movl a6@(16),d3
! 3850: cmpl #-1,d3
! 3851: beq 1$
! 3852: | ici quotient attendu (q=0)
! 3853: movl _gzero,d0
! 3854: 1$: tstl d3
! 3855: beq dvmiif
! 3856: | ici reste attendu (r=0)
! 3857: movl _gzero,a0
! 3858: btst #0,d3 | test si fonction mod
! 3859: bne 2$
! 3860: movl d3,a1 | d3 pointe sur l'adr. du reste
! 3861: movl a0,a1@
! 3862: bra dvmiif
! 3863: 2$: movl a0,d0
! 3864: bra dvmiif
! 3865: | ici i2 et i1 <> 0
! 3866: dv3: movw d2,d0 | le2
! 3867: subw d1,d0 | d0.w contient L2-L1
! 3868: bcc dv4
! 3869: | ici q=0 , r=i2
! 3870: movl a6@(16),d3
! 3871: cmpl #-1,d3
! 3872: beq 1$
! 3873: | quotient attendu soit q=0
! 3874: movl _gzero,d0
! 3875: 1$: tstl d3
! 3876: beq dvmiif
! 3877: | reste attendu soit r=i1
! 3878: movl d0,d1
! 3879: movw d2,d0
! 3880: bsr geti
! 3881: movl a0,a1
! 3882: subqw #2,d0
! 3883: addql #4,a0
! 3884: addql #4,a2
! 3885: 2$: movl a2@+,a0@+
! 3886: dbra d0,2$
! 3887: cmpl #-1,d3
! 3888: beq 3$
! 3889: movl d3,a0
! 3890: movl a1,a0@
! 3891: movl d1,d0
! 3892: bra dvmiif
! 3893: 3$: movl a1,d0
! 3894: bra dvmiif
! 3895: | ici L2 >= L1
! 3896: dv4: movb a1@(4),d3 | d3.b contient signe de i1
! 3897: movb a2@(4),d4 | d4.b contient signe de i2
! 3898: eorb d4,d3
! 3899: addqb #1,d3 | d4.b contient signe de q
! 3900: movb d3,a6@(-12) | sauvegarde signe de q
! 3901: movb d4,a6@(-10) | sauvegarde signe de r
! 3902: movl _avma,a6@(-20) | sauvegarde _avma initial
! 3903: movw d2,d0 | d0 recoit l2
! 3904: bsr geti | allocation memoire de travail :
! 3905: | on va y former q0q1...q(n-m)r1r2...rm
! 3906: | les memoires provisoires ne seront pas
! 3907: | rendues par giv:on ecrase mot code
! 3908: movl a0,a6@(-4) | sauvegarde addresse zone de travail
! 3909: subqw #2,d1
! 3910: subqw #2,d2
! 3911: movw d1,a6@(-6) | sauvegarde L1 (=m)
! 3912: movw d2,a6@(-8) | sauvegarde L2 (=n)
! 3913: movw d2,a6@(-16)
! 3914: subw d1,a6@(-16) | n-m dans a6@(-16)
! 3915: addql #8,a2
! 3916: addql #8,a1
! 3917: movl a1@,d3 | d3.l=y1 (1er lgmot du diviseur i1)
! 3918: subqw #1,d2 | d2 recoit n-1
! 3919: subqw #1,d1 | d1 recoit m-1
! 3920: bne divlon
! 3921: | ici division simple (m = 1)
! 3922: divsim: clrl d4
! 3923: 1$: movl a2@+,d5
! 3924: divul d3,d4:d5
! 3925: movl d5,a0@+
! 3926: dbra d2,1$
! 3927: movl d4,a0@ | reste mis derriere quotient
! 3928: movl a0,a2 | a2 pointe sur reste
! 3929: clrw a6@(-14) | on n'a pas fait de shift
! 3930: bra ranger
! 3931: | ici division longue (m > 1)
! 3932: divlon: bfffo d3{#0:#0},d4 | d4 recoit nb de shift pour normaliser
! 3933: movw d4,a6@(-14) | sauvegarde du nb. de shifts = k
! 3934: bne 1$
! 3935: | ici pas de normalisation
! 3936: movl a0,a4
! 3937: movl #0,a4@+ | met a 0 1er lgmot soit x0
! 3938: 4$: movl a2@+,a4@+ | recopie x1x2...xn
! 3939: dbra d2,4$
! 3940: movl a0,a2 | a2 pointe sur x0,a4 pointe apres xn
! 3941: lea a1@(4,d1:w:4),a3| a1 pointe sur y1,a3 pointe apres ym
! 3942: bra nosh
! 3943: | ici on normalise le diviseur i1=y
! 3944: | et on decale autant le dividende:
! 3945: 1$: lsll d4,d3 | normalisation de y1
! 3946: movw a6@(-6),d0 | on demande m lgmots
! 3947: bsr geti | allocation pour copie normalisee de y
! 3948: moveq #1,d6
! 3949: lsll d4,d6
! 3950: subql #1,d6 | masque de shift
! 3951: movl a0,a3
! 3952: subqw #1,d0 | d0 compt. mis a m-1
! 3953: addql #4,a1 | a1 pointe sur y2 2me lg mot diviseur
! 3954: bra 3$
! 3955: 2$: movl a1@+,d1 | boucle shift vers la gauche ds copie
! 3956: roll d4,d1
! 3957: movl d1,d5
! 3958: andl d6,d1
! 3959: addl d1,d3
! 3960: movl d3,a3@+
! 3961: subl d1,d5
! 3962: movl d5,d3
! 3963: 3$: dbra d0,2$
! 3964: movl d3,a3@+
! 3965: movl a0,a1 | a1 pointe sur 1er lgmot y1 normalise
! 3966: | a3 pointe apres ym
! 3967: | transfert avec shift du dividende:
! 3968: movl a6@(-4),a4 | a4 pointe sur zone de travail
! 3969: moveq #0,d3
! 3970: movw a6@(-8),d0
! 3971: subqw #1,d0 | d0 recoit n-1 compteur
! 3972: 5$: movl a2@+,d1 | boucle de shift du dividende i2
! 3973: roll d4,d1 | sur place
! 3974: movl d1,d5
! 3975: andl d6,d1
! 3976: addl d1,d3
! 3977: movl d3,a4@+
! 3978: subl d1,d5
! 3979: movl d5,d3
! 3980: dbra d0,5$
! 3981: movl d3,a4@
! 3982: movl a6@(-4),a2 | a2 pointe sur x0 ;(a4 pointe sur xn)
! 3983: nosh: movw a6@(-6),d6 | d6 recoit m
! 3984: lea a2@(4,d6:w:4),a4| a4 pointe apres xm
! 3985: subqw #1,d6 | d6 recoit m-1 compteur bcls internes
! 3986: movw a6@(-16),d7 | d7 recoit n-m compteur bcl externe
! 3987: #-------------------------------------------------------------------#
! 3988: | boucles de division I / I :
! 3989: | a1 pointe sur y1, a3 pointe apres ym : diviseur y1y2...ym
! 3990: | a2 pointe sur x0, a4 pointe apres xm : dividende x0x1...xn
! 3991: | d7 contient n-m compt. boucle externe
! 3992: | d6 contient m compt. boucles internes (n>=m>=2)
! 3993: | la zone x0x1...xn recoit q0q1...q(n-m)r1r2...rm
! 3994:
! 3995: bclext: movl a1@,d0 | d0 recoit y1 (1er lgmot diviseur)
! 3996: cmpl a2@,d0 | xi = y1 ? (i=0,1...n)
! 3997: bne 1$
! 3998: moveq #-1,d1 | oui: essayer q=2^32-1
! 3999: addl a2@(4),d0 | calcul du reste
! 4000: | r=xix(i+1) mod y1 = xi+x(i+1)
! 4001: bcs 4$ | si r>=2^32 , q est ok
! 4002: movl d0,d2 | sinon d2 recoit r
! 4003: bra 2$ | rejoindre cas general
! 4004: 1$: movl a2@,d2 | si xi<y1 :
! 4005: movl a2@(4),d1 | d2:d1 recoit xix(i+1)
! 4006: divul d0,d2:d1 | d1 recoit q = xix(i+1) div y1
! 4007: | d2 recoit r = xix(i+1) mod y1
! 4008: 2$: movl a1@(4),d3 | d3 recoit y2
! 4009: mulul d1,d4:d3 | d4:d3 recoit q*y2
! 4010: subl a2@(8),d3
! 4011: subxl d2,d4 | d4:d3 recoit q*y2-(r,x(i+2))
! 4012: bls 4$ | si <= 0 alors q ok
! 4013: 3$: subql #1,d1 | sinon diminuer q
! 4014: subl a1@(4),d3 | corriger reste partiel:
! 4015: subxl d0,d4 | d3:d4 recoit d3:d4-y1y2
! 4016: bhi 3$ | tant que q*y1y2>xix(i+1)x(i+2)
! 4017: | recommencer q recoit q-1
! 4018: | ici q*y1y2 <= xix(i+1)x(i+2)
! 4019: | on va former le nouveau reste
! 4020: | en remplacant x(i+1)...x(i+m) par
! 4021: | x(i+1)...x(i+m) - q*y1...ym
! 4022: 4$: movw d6,d0 | d0 recoit m-1 compteur
! 4023: movl a3,a1 | a1 pointe apres ym
! 4024: movl a4,a2 | a2 pointe apres x(i+m)
! 4025: moveq #0,d2 | d2 fixe a 0 pour les addxl
! 4026: subl d3,d3 | d3 recoit k retenue initialisee a 0 et X=0
! 4027: 5$: movl a1@-,d5 | d5 recoit x(i+j) j=m,m-1,...,1
! 4028: mulul d1,d4:d5
! 4029: addxl d3,d5
! 4030: addxl d2,d4
! 4031: subl d5,a2@- | nouvel x(i+j)
! 4032: movl d4,d3
! 4033: dbra d0,5$
! 4034: addxl d2,d3
! 4035: subl d3,a2@(-4) | soustrait derniere retenue
! 4036: bcc 6$ | si pas carry q=qi est definitif
! 4037: subql #1,d1 | sinon encore 1 de trop
! 4038: movw d6,d0 | repositionner compteur m-1
! 4039: movl a3,a1
! 4040: movl a4,a2 | repositionner pointeurs
! 4041: 7$: addxl a1@-,a2@-
! 4042: dbra d0,7$ | boucle de remise a jour du reste
! 4043: | il y a forcement carry final a ignorer
! 4044: 6$: movl d1,a2@(-4) | qi est range sur l'ancien xi
! 4045: addql #4,a4 | a4 pointe apres x(i+m+1)
! 4046: dbra d7,bclext | boucler pour q0q1...q(n-m)
! 4047: | fin des boucles de division I/I
! 4048: | a2 pointe apres q(n-m),ie sur r1
! 4049: #-------------------------------------------------------------------#
! 4050: | rangement des resultats
! 4051:
! 4052: ranger: clrl a6@(-28)
! 4053: clrl a6@(-32)
! 4054: movl _avma,a6@(-24) | actuel _avma
! 4055: movl a6@(-20),d7 | _avma initial
! 4056: subl _avma,d7 | nb d'octets memoire provisoires
! 4057: | offset:ajouter aux addresses fournies
! 4058: movl a6@(16),d3
! 4059: cmpl #-1,d3
! 4060: beq rngres
! 4061: | ici quotient attendu
! 4062: movl a6@(-4),a0 | a0 pointe sur q0
! 4063: movw a6@(-16),d0 | d0 recoit n-m
! 4064: movw d0,d1
! 4065: addqw #2,d0
! 4066: tstl a0@
! 4067: beq 1$
! 4068: addqw #1,d0
! 4069: 1$: bsr geti | allocation memoire pour quotient
! 4070: movl a0,a6@(-28) | a6@(-28) recoit adr. provisoire de q
! 4071: addl d7,a6@(-28) | ajoute offset memoires provisoires
! 4072: | a6@(-28) contient adr definitive de q
! 4073: lea a0@(0,d0:w:4),a1
! 4074: movl a2,a3 | a2 et a3 pointe sur r1
! 4075: 2$: movl a3@-,a1@- | recopie q0,q1...q(n-m)
! 4076: dbra d1,2$
! 4077: movw d0,a0@(6) | met long effective de q
! 4078: movb a6@(-12),a0@(4) | met signe de q
! 4079: cmpw #2,d0
! 4080: bne rngres
! 4081: clrb a0@(4) | rectifier signe lorsque q=0
! 4082: rngres: tstl d3
! 4083: beq rendre
! 4084: | ici reste attendu
! 4085: movw a6@(-6),d0
! 4086: subqw #1,d0 | d0 recoit m-1
! 4087: 4$: tstl a2@+
! 4088: dbne d0,4$ | chasse les zeros
! 4089: bne 1$
! 4090: | ici r=0 : ranger 0
! 4091: movw #2,d0
! 4092: bsr geti
! 4093: movl #2,a0@(4)
! 4094: addl d7,a0 | ajoute offset
! 4095: movl a0,a6@(-32) | adr. definit. de r
! 4096: bra rendre
! 4097: 1$: subql #4,a2 | a2 pointe sur 1er ri non nul
! 4098: movw d0,d1
! 4099: addqw #3,d0
! 4100: bsr geti | allocation memoire pour reste
! 4101: movl a0,a6@(-32)
! 4102: addl d7,a6@(-32) | ajoute offset memoires provisoires
! 4103: movb a6@(-10),a0@(4) | met signe de r
! 4104: movw d0,a0@(6) | met long effect provisoire (si shift)
! 4105: addql #8,a0
! 4106: movw a6@(-14),d3 | d3 recoit k nb de shifts
! 4107: bne 2$
! 4108: | ici k=0 pas de shift
! 4109: 5$: movl a2@+,a0@+
! 4110: dbra d1,5$ | recopie des ri effectifs
! 4111: bra rendre
! 4112: 2$: moveq #-1,d6 | ici shift de r
! 4113: lsrl d3,d6 | d6 recoit masque de shift
! 4114: moveq #0,d5
! 4115: bset d3,d5 | d5 recoit 2^k
! 4116: moveq #0,d2
! 4117: cmpl a2@,d5 | comparer 1er ri a 2^k
! 4118: bls 3$
! 4119: movl a2@+,d2 | ici ri < 2^k : le shifter
! 4120: rorl d3,d2
! 4121: subqw #1,d0 | et diminuer de 1 la long de la boucle
! 4122: subqw #1,a0@(-2) | ainsi que la long effective de r
! 4123: 3$: movl a2@+,d5 | boucle de shift de r
! 4124: rorl d3,d5 | boucle jamais vide car r>=2^k
! 4125: movl d5,d4
! 4126: andl d6,d4
! 4127: addl d4,d2
! 4128: movl d2,a0@+
! 4129: subl d4,d5
! 4130: movl d5,d2
! 4131: dbra d1,3$
! 4132: rendre: movl a6@(-20),a0 | rendre memoires provisoires
! 4133: movl a6@(-24),a1 | il faut rendre la zone entre a1 et a0
! 4134: movl a1,d0
! 4135: subl _avma,d0
! 4136: lsrl #2,d0 | nb de lgmots a deplacer
! 4137: subqw #1,d0
! 4138: 1$: movl a1@-,a0@-
! 4139: dbra d0,1$
! 4140: movl a0,_avma | nouvel _avma
! 4141: movl a6@(-28),d0
! 4142: bne 2$
! 4143: movl a6@(-32),d0
! 4144: bra dvmiif
! 4145: 2$: tstl a6@(-32)
! 4146: beq dvmiif
! 4147: movl a6@(16),a1
! 4148: movl a6@(-32),a1@
! 4149: dvmiif: moveml sp@+,d2-d7/a2-a4
! 4150: unlk a6
! 4151: rts
! 4152:
! 4153:
! 4154:
! 4155: #===================================================================#
! 4156: # #
! 4157: # Divisibilite de i2 par i1 #
! 4158: # #
! 4159: # entree : a7@(4) pointe sur n2 de type I #
! 4160: # a7@(8) pointe sur n1 de type I #
! 4161: # a7@(12) contient un pointeur ( pour quotient ) #
! 4162: # sortie : d0 contient 1 si n1 divise n2 #
! 4163: # 0 sinon
! 4164: # a7@(12) pointe sur n2 / n1 de type I (zone creee) #
! 4165: # lorsque n1 divise n2, sinon n'est pas affecte. #
! 4166: # #
! 4167: #===================================================================#
! 4168:
! 4169: _mpdivis:link a6,#-8
! 4170: movl _avma,a6@(-8)
! 4171: pea a6@(-4)
! 4172: movl a6@(12),sp@-
! 4173: movl a6@(8),sp@-
! 4174: bsr _asmdvmdii
! 4175: lea sp@(12),sp
! 4176: tstb a6@(-4)@(4) | reste nul ?
! 4177: beq 1$
! 4178: | ici reste non nul
! 4179: moveq #0,d0
! 4180: movl a6@(-8),_avma | desallouer q et r
! 4181: bra 2$
! 4182: | ici reste nul
! 4183: 1$: movl a6@(16),sp@-
! 4184: movl d0,sp@- | adresse du quotient
! 4185: bsr _affii
! 4186: moveq #1,d0
! 4187: movl a6@(-8),_avma | desallouer reste
! 4188: 2$: unlk a6
! 4189: rts
! 4190:
! 4191:
! 4192: #===================================================================#
! 4193: # #
! 4194: # Flag de divisibilite de i2 par i1 #
! 4195: # #
! 4196: # entree : a7@(4) pointe sur n2 de type I #
! 4197: # a7@(8) pointe sur n1 de type I #
! 4198: # sortie : d0 contient 1 si n1 divise n2 #
! 4199: # 0 sinon #
! 4200: # #
! 4201: #===================================================================#
! 4202:
! 4203: _divise: movl #-1,sp@-
! 4204: movl sp@(12),sp@-
! 4205: movl sp@(12),sp@-
! 4206: bsr _asmdvmdii
! 4207: lea sp@(12),sp
! 4208: movl d0,a0
! 4209: moveq #1,d0
! 4210: tstb a0@(4) | reste nul ?
! 4211: beq giv
! 4212: | ici reste non nul
! 4213: moveq #0,d0
! 4214: bra giv
! 4215:
! 4216:
! 4217:
! 4218:
! 4219: #*******************************************************************#
! 4220: #*******************************************************************#
! 4221: #** **#
! 4222: #** PROGRAMMES DE DIVISION **#
! 4223: #** **#
! 4224: #*******************************************************************#
! 4225: #*******************************************************************#
! 4226:
! 4227:
! 4228:
! 4229:
! 4230:
! 4231: #===================================================================#
! 4232: # #
! 4233: # Division generale #
! 4234: # #
! 4235: # entree : a7@(4) pointe sur n2 de type I ou R #
! 4236: # a7@(8) pointe sur n1 de type I ou R #
! 4237: # sortie : d0 pointe sur n2 / n1 de type I ou R (zone creee) #
! 4238: # Le reste est du signe du dividende #
! 4239: # interdit : type S #
! 4240: # precision : voir routines specialisees #
! 4241: # #
! 4242: #===================================================================#
! 4243:
! 4244: _mpdiv: cmpb #1,sp@(8)@
! 4245: bne 1$
! 4246: cmpb #1,sp@(4)@
! 4247: beq _divii
! 4248: bra _divri
! 4249: 1$: cmpb #1,sp@(4)@
! 4250: beq _divir
! 4251: bra _divrr
! 4252:
! 4253: #===================================================================#
! 4254: # #
! 4255: # Division (par valeur) #
! 4256: # #
! 4257: # entree : a7@(4) pointe sur n2 de type I ou R #
! 4258: # a7@(8) pointe sur n1 de type I ou R #
! 4259: # a7@(12) pointe sur n3 de type I ou R #
! 4260: # sortie : la zone pointee par a7@(12) contient n2 / n1 de #
! 4261: # type le type de n3 #
! 4262: # interdit : type S ainsi que les divisions suivantes : #
! 4263: # R/I=I , I/R=I ,R/R=I #
! 4264: # #
! 4265: #===================================================================#
! 4266:
! 4267: _mpdivz:movl a2,sp@-
! 4268: movl _avma,sp@-
! 4269: movl sp@(12),a1
! 4270: movl sp@(16),a0
! 4271: movl sp@(20),a2 | a0,a1,a2 pointent sur n1,n2,n3
! 4272: cmpb #1,a2@
! 4273: bne 1$
! 4274: | ici T3 = I
! 4275: cmpb #1,a1@
! 4276: beq 2$
! 4277: | ici T3 = I et (T2 = R ou T1 = R)
! 4278: 3$: movl #divzer1,sp@-
! 4279: jsr _pari_err
! 4280: | ici T3 = I et T2 = I
! 4281: 2$: cmpb #1,a0@
! 4282: bne 3$
! 4283: | ici T3 = T2 = T1 = I
! 4284: movl a0,sp@-
! 4285: movl a1,sp@-
! 4286: bsr _divii
! 4287: movl a2,sp@(4)
! 4288: movl d0,sp@
! 4289: bsr _affii
! 4290: addql #8,sp
! 4291: bra divzf
! 4292: | ici T3 = R
! 4293: 1$: movl a0,sp@-
! 4294: cmpb #1,a0@
! 4295: beq 4$
! 4296: | ici T3 = R et T1 = R
! 4297: movl a1,sp@-
! 4298: cmpb #1,a1@
! 4299: beq 5$
! 4300: | ici T3 =T2 = T1 = R
! 4301: bsr _divrr
! 4302: bra 6$
! 4303: | ici T3 = T1 = R et T2 = I
! 4304: 5$: bsr _divir
! 4305: bra 6$
! 4306: | ici T3 = R et T1 = I
! 4307: 4$: cmpb #1,a1@
! 4308: beq 7$
! 4309: | ici T3 = T2 = R et T1 = I
! 4310: movl a1,sp@-
! 4311: bsr _divri
! 4312: bra 6$
! 4313: | ici T3 = R et T2 = T1 = I
! 4314: 7$: movw a2@(2),d0
! 4315: addqw #1,d0
! 4316: bsr getr
! 4317: movl a0,sp@-
! 4318: movl a1,sp@-
! 4319: bsr _affir
! 4320: addql #4,sp
! 4321: bsr _divri
! 4322: 6$: movl a2,sp@(4)
! 4323: movl d0,sp@
! 4324: bsr _affrr
! 4325: addql #8,sp
! 4326: divzf: movl sp@+,_avma
! 4327: movl sp@+,a2
! 4328: rts
! 4329:
! 4330: | division S/R=R sinon erreur
! 4331:
! 4332: _divsrz:lea _divsr,a0
! 4333: bra mpopz
! 4334:
! 4335: | division R/S=R sinon erreur
! 4336:
! 4337: _divrsz:lea _divrs,a0
! 4338: bra mpopz
! 4339:
! 4340: | division I/R=R sinon erreur
! 4341:
! 4342: _divirz:lea _divir,a0
! 4343: bra mpopz
! 4344:
! 4345: | division R/I=R sinon erreur
! 4346:
! 4347: _divriz:lea _divri,a0
! 4348: bra mpopz
! 4349:
! 4350: | division R/R=R sinon erreur
! 4351:
! 4352: _divrrz:lea _divrr,a0
! 4353: bra mpopz
! 4354: #===================================================================#
! 4355: # #
! 4356: # Division par valeur : entier / entier = entier ou reel #
! 4357: # #
! 4358: # entree : a7@(4) contient i2 de type S #
! 4359: # a7@(8) contient i1 de type S #
! 4360: # a7@(12) pointe sur i3 ou r3 de type I ou R #
! 4361: # sortie : a7@(12) pointe sur i2 / i1 de type I ou R #
! 4362: # #
! 4363: #===================================================================#
! 4364:
! 4365: _divssz:cmpb #1,sp@(12)@
! 4366: bne divssr
! 4367: divssi: movl sp@(8),sp@-
! 4368: movl sp@(8),sp@-
! 4369: bsr _divss
! 4370: movl sp@(20),sp@(4)
! 4371: movl d0,sp@
! 4372: bsr _affii
! 4373: movl sp@,a0
! 4374: addql #8,sp
! 4375: bra giv
! 4376: divssr: movl _avma,sp@-
! 4377: movw sp@(16)@(2),d0
! 4378: bsr getr
! 4379: movl a0,sp@-
! 4380: movl sp@(12),sp@-
! 4381: bsr _affsr | conversion dividende en R
! 4382: movl sp@(4),sp@ | dividende converti
! 4383: movl sp@(20),sp@(4) | diviseur (type S)
! 4384: bsr _divrs
! 4385: movl sp@(24),sp@(4)
! 4386: movl d0,sp@
! 4387: bsr _affrr
! 4388: addql #8,sp
! 4389: movl sp@+,_avma
! 4390: rts
! 4391:
! 4392: #===================================================================#
! 4393: # #
! 4394: # Division par valeur : S / I = entier ou reel #
! 4395: # #
! 4396: # entree : a7@(4) contien i2 de type S #
! 4397: # a7@(8) pointe sur i1 de type I #
! 4398: # a7@(12) pointe sur i3 ou r3 de type I ou R #
! 4399: # sortie : a7@(12) pointe sur i2 / i1 de type I ou R #
! 4400: # #
! 4401: #===================================================================#
! 4402:
! 4403: _divsiz:link a6,#0
! 4404: moveml a2-a4,sp@-
! 4405: movl a6@(16),a3
! 4406: cmpb #1,a3@
! 4407: bne divsir
! 4408: divsii: movl a6@(12),sp@-
! 4409: movl a6@(8),sp@-
! 4410: bsr _divsi
! 4411: movl a6@(16),sp@(4)
! 4412: movl d0,sp@
! 4413: bsr _affii
! 4414: movl sp@,a0
! 4415: addql #8,sp
! 4416: bsr giv
! 4417: divsizf:moveml sp@+,a2-a4
! 4418: unlk a6
! 4419: rts
! 4420: divsir: movl _avma,a2
! 4421: movw a3@(2),d0
! 4422: addqw #1,d0
! 4423: bsr getr
! 4424: movl a0,a4
! 4425: movl a0,sp@-
! 4426: movl a6@(8),sp@-
! 4427: bsr _affsr | conversion dividende en R
! 4428: addql #2,d0
! 4429: bsr getr
! 4430: movl a0,sp@(4)
! 4431: movl a6@(12),sp@
! 4432: bsr _affir | conversion diviseur en R
! 4433: movl a4,sp@
! 4434: bsr _divrr
! 4435: movl a3,sp@(4)
! 4436: movl d0,sp@
! 4437: bsr _affrr
! 4438: addql #8,sp
! 4439: movl a2,_avma
! 4440: bra divsizf
! 4441:
! 4442: #===================================================================#
! 4443: # #
! 4444: # Division par valeur : I / S = entier ou reel #
! 4445: # #
! 4446: # entree : a7@(4) pointe sur i2 de type I #
! 4447: # a7@(8) contient i1 de type S #
! 4448: # a7@(12) pointe sur i3 ou r3 de type I ou R #
! 4449: # sortie : a7@(12) pointe sur i2 / i1 de type I ou R #
! 4450: # #
! 4451: #===================================================================#
! 4452:
! 4453: _divisz:cmpb #1,sp@(12)@
! 4454: bne divisr
! 4455: divisi: movl sp@(8),sp@-
! 4456: movl sp@(8),sp@-
! 4457: bsr _divis
! 4458: movl sp@(20),sp@(4)
! 4459: movl d0,sp@
! 4460: bsr _affii
! 4461: movl sp@,a0
! 4462: addql #8,sp
! 4463: bra giv
! 4464: divisr: movl _avma,sp@-
! 4465: movw sp@(16)@(2),d0
! 4466: bsr getr
! 4467: movl a0,sp@-
! 4468: movl sp@(12),sp@-
! 4469: bsr _affir | conversion dividende en R
! 4470: movl sp@(4),sp@ | dividende converti
! 4471: movl sp@(20),sp@(4) | diviseur (type S)
! 4472: bsr _divrs
! 4473: movl sp@(24),sp@(4)
! 4474: movl d0,sp@
! 4475: bsr _affrr
! 4476: addql #8,sp
! 4477: movl sp@+,_avma
! 4478: rts
! 4479:
! 4480: #===================================================================#
! 4481: # #
! 4482: # Division par valeur : entier / entier = entier ou reel #
! 4483: # #
! 4484: # entree : a7@(4) pointe sur i2 de type I #
! 4485: # a7@(8) pointe sur i1 de type I #
! 4486: # a7@(12) pointe sur i3 ou r3 de type I ou R #
! 4487: # sortie : a7@(12) pointe sur i2 / i1 de type I ou R #
! 4488: # #
! 4489: #===================================================================#
! 4490:
! 4491: _diviiz:link a6,#0
! 4492: moveml a2-a4,sp@-
! 4493: movl a6@(16),a3
! 4494: cmpb #1,a3@
! 4495: bne diviir
! 4496: diviii: movl a6@(12),sp@-
! 4497: movl a6@(8),sp@-
! 4498: bsr _divii
! 4499: movl a6@(16),sp@(4)
! 4500: movl d0,sp@
! 4501: bsr _affii
! 4502: movl sp@,a0
! 4503: addql #8,sp
! 4504: bsr giv
! 4505: diviizf:moveml sp@+,a2-a4
! 4506: unlk a6
! 4507: rts
! 4508: diviir: movl _avma,a2
! 4509: movw a3@(2),d0
! 4510: bsr getr
! 4511: movl a0,a4
! 4512: movl a0,sp@-
! 4513: movl a6@(8),sp@-
! 4514: bsr _affir | conversion dividende en R
! 4515: addql #2,d0
! 4516: bsr getr
! 4517: movl a0,sp@(4)
! 4518: movl a6@(12),sp@
! 4519: bsr _affir | conversion diviseur en R
! 4520: movl a4,sp@
! 4521: bsr _divrr
! 4522: movl a3,sp@(4)
! 4523: movl d0,sp@
! 4524: bsr _affrr
! 4525: addql #8,sp
! 4526: movl a2,_avma
! 4527: bra diviizf
! 4528:
! 4529:
! 4530: #===================================================================#
! 4531: # #
! 4532: # Division : entier court / entier court = entier #
! 4533: # #
! 4534: # entree : a7@(4) contient s2 de type S #
! 4535: # a7@(8) contient s1 de type S #
! 4536: # sortie : d0 pointe sur s2 div s1 de type I (zone creee) #
! 4537: # d1.l contient le reste(du signe du dividende) #
! 4538: # #
! 4539: #===================================================================#
! 4540:
! 4541: _divss: link a6,#0
! 4542: moveml d2-d3,sp@-
! 4543: moveq #0,d3
! 4544: movl a6@(12),d1 | d1.l recoit s1
! 4545: bne 1$
! 4546: | ici s1 = 0
! 4547: movl #diver1,sp@-
! 4548: jsr _pari_err
! 4549: | ici s1 <> 0
! 4550: 1$: movl a6@(8),d2 | d2.l recoit s2
! 4551: bpl 9$
! 4552: moveq #-1,d3
! 4553: 9$: divsll d1,d3:d2
! 4554: bne 2$
! 4555: | ici quotient nul
! 4556: 3$: movl _gzero,d0
! 4557: movl d3,d1
! 4558: bra divssg
! 4559: | ici quotient non nul
! 4560: 2$: moveq #3,d0
! 4561: bsr geti
! 4562: movl #0x1000003,a0@(4)
! 4563: tstl d2
! 4564: bpl 4$
! 4565: negl d2
! 4566: movb #-1,a0@(4)
! 4567: 4$: movl d2,a0@(8)
! 4568: movl d3,d1
! 4569: divssf: movl a0,d0
! 4570: divssg: moveml sp@+,d2-d3
! 4571: unlk a6
! 4572: rts
! 4573:
! 4574: #===================================================================#
! 4575: # #
! 4576: # Division : entier court / entier = entier #
! 4577: # #
! 4578: # entree : a7@(4) contient s2 de type S #
! 4579: # a7@(8) contient i1 de type I #
! 4580: # sortie : d0 pointe sur s2 div i1 de type I (zone creee) #
! 4581: # d1.l contient le reste (du signe du dividende) #
! 4582: # #
! 4583: #===================================================================#
! 4584:
! 4585: _divsi: link a6,#0
! 4586: moveml d2-d4,sp@-
! 4587: movl a6@(12),a1 | a1 pointe sur le diviseur i1
! 4588: tstb a1@(4)
! 4589: bne 1$
! 4590: | ici i1 = 0
! 4591: movl #diver2,sp@-
! 4592: jsr _pari_err
! 4593: | ici i1 <> 0
! 4594: 1$: movl a6@(8),d2 | d2.l contient le dividende s2
! 4595: bne 3$
! 4596: | ici quotient et reste nuls
! 4597: 2$: movl _gzero,d0
! 4598: moveq #0,d1
! 4599: bra divsig
! 4600: | ici i1 et s2 <> 0
! 4601: 3$: movw a1@(6),d1 | d1.w contient le1
! 4602: cmpw #3,d1
! 4603: beq 4$
! 4604: | ici quotient nul et reste=s2
! 4605: 6$: movl _gzero,a0
! 4606: movl d2,d1
! 4607: bra divsif
! 4608: | ici L1 = 1
! 4609: 4$: movl a1@(8),d1 | d1.l contient |i1|
! 4610: movl d2,d3 | d3.l contient s2
! 4611: bpl 5$
! 4612: negl d3 | d3.l contient |s2|
! 4613: 5$: moveq #0,d4
! 4614: divul d1,d4:d3
! 4615: beq 6$
! 4616: moveq #3,d0
! 4617: bsr geti
! 4618: movl d3,a0@(8) | ranger mantisse
! 4619: movl a1@(4),a0@(4)
! 4620: tstl d2
! 4621: bpl 7$
! 4622: movb #-1,a0@(4) | mise a jour du signe
! 4623: 7$: movl d4,d1
! 4624: tstb a1@(4)
! 4625: bpl divsif
! 4626: negl d1 | mise a jour reste
! 4627: divsif: movl a0,d0
! 4628: divsig: moveml sp@+,d2-d4
! 4629: unlk a6
! 4630: movl d1,_hiremainder
! 4631: rts
! 4632:
! 4633: #===================================================================#
! 4634: # #
! 4635: # Division : entier court / reel = reel #
! 4636: # #
! 4637: # entree : a7@(4) contient s2 de type S #
! 4638: # a7@(8) pointe sur r1 de type R #
! 4639: # sortie : d0 pointe sur s2 / r1 de type R (zone creee) #
! 4640: # #
! 4641: #===================================================================#
! 4642:
! 4643: _divsr: link a6,#-32
! 4644: moveml d2/a2-a4,sp@-
! 4645: movl a6@(12),a1 | a1 pointe sur r1
! 4646: tstb a1@(4)
! 4647: bne 2$
! 4648: | ici r1 = 0
! 4649: movl #diver3,sp@-
! 4650: jsr _pari_err
! 4651: | ici r1 <> 0
! 4652: 2$: tstl a6@(8)
! 4653: bne 1$
! 4654: | ici s2 = 0
! 4655: movl _gzero,d0
! 4656: bra divsrf
! 4657: | ici s2 et r1 <> 0
! 4658: 1$: moveq #0,d0
! 4659: movw a1@(2),d0
! 4660: bsr getr | allocation pour resultat
! 4661: movl a6@(8),d2 | d2.l recoit s2
! 4662: movl a0,a4
! 4663: addqw #1,d0
! 4664: bsr getr
! 4665: movl a0,sp@- | sauvegarde adr. copie
! 4666: movl d2,sp@-
! 4667: bsr _affsr
! 4668: addql #4,sp
! 4669: movl a0,a2 | a2 pointe sur copie s2
! 4670: movl a4,a0 | a0 pointe sur resultat
! 4671: bsr dvrr
! 4672: movl sp@+,a0
! 4673: bsr giv | desallouer copie
! 4674: movl a4,d0
! 4675: divsrf: moveml sp@+,d2/a2-a4
! 4676: unlk a6
! 4677: rts
! 4678:
! 4679: #===================================================================#
! 4680: # #
! 4681: # Division : entier / entier court = entier #
! 4682: # #
! 4683: # entree : a7@(4) pointe sur i2 de type I #
! 4684: # a7@(8) contient s1 de type S #
! 4685: # sortie : d0 pointe sur i2 / s1 de type I (zone creee) #
! 4686: # le reste est dans d1.l (du signe du dividende) #
! 4687: # #
! 4688: #===================================================================#
! 4689:
! 4690: _divis: link a6,#0
! 4691: moveml d2-d6/a2,sp@-
! 4692: movl a6@(12),d1 | d1 recoit s1 diviseur
! 4693: bne 1$
! 4694: movl #diver4,sp@-
! 4695: jsr _pari_err
! 4696: 1$: bpl 2$
! 4697: negl d1
! 4698: | ici d1 contient |s1|
! 4699: 2$: movl a6@(8),a2 | a2 pointe sur i2 dividende
! 4700: movw a2@(6),d2 | d2 recoit le2
! 4701: movw a2@(4),d5 | signe de i2
! 4702: bne 4$
! 4703: | ici i2=0 : q=0 , r=0
! 4704: 3$: movl _gzero,d0
! 4705: moveq #0,d1 | reste nul
! 4706: bra divisg
! 4707: | ici i2 et s1 <>0
! 4708: 4$: movw d2,d0 | d0 recoit le2
! 4709: addql #8,a2
! 4710: movl a2@+,d4
! 4711: moveq #0,d3
! 4712: divull d1,d3:d4 | calcul de q0
! 4713: bne 5$
! 4714: | ici q0 = 0
! 4715: subqw #1,d0 | diminuer long. effective
! 4716: cmpw #2,d0
! 4717: bne 5$
! 4718: | ici q=0 , reste dans d3
! 4719: movl _gzero,a0
! 4720: bra 10$
! 4721: | ici q <> 0
! 4722: 5$: bsr geti
! 4723: movl a0,a1
! 4724: movw d0,a0@(6) | met long. effect.
! 4725: movb #1,a0@(4)
! 4726: movw a6@(12),d6 | 'signe de s1'
! 4727: eorw d5,d6
! 4728: bpl 6$ | si de meme signe
! 4729: movb #-1,a0@(4) | si de signes contraires
! 4730: 6$: addql #8,a1
! 4731: tstl d4 | q0 = 0 ?
! 4732: beq 7$
! 4733: movl d4,a1@+ | non: ranger q0
! 4734: 7$: subqw #3,d2 | d2 recoit L1 -1 compteur
! 4735: bra 9$
! 4736: 8$: movl a2@+,d4 | boucle de division
! 4737: divul d1,d3:d4
! 4738: movl d4,a1@+
! 4739: 9$: dbra d2,8$
! 4740: 10$: movl d3,d1 | le reste est mis dans d1
! 4741: tstw d5 | i1 > 0 ?
! 4742: bpl divisf
! 4743: negl d1 | non : changer signe de r
! 4744: divisf: movl a0,d0 | met addresse resultat
! 4745: divisg: moveml sp@+,d2-d6/a2
! 4746: unlk a6
! 4747: movl d1,_hiremainder
! 4748: rts
! 4749:
! 4750: #===================================================================#
! 4751: # #
! 4752: # Division : entier / entier = entier #
! 4753: # #
! 4754: # entree : a7@(4) pointe sur i2 de type I #
! 4755: # a7@(8) pointe sur i1 de type I #
! 4756: # sortie : d0 pointe sur i2 / i1 de type I (zone creee) #
! 4757: # Le reste est du signe du dividende #
! 4758: # #
! 4759: #===================================================================#
! 4760:
! 4761: _divii: clrl sp@-
! 4762: movl sp@(12),sp@- | empilage de i1
! 4763: movl sp@(12),sp@- | empilage de i2
! 4764: bsr _asmdvmdii
! 4765: lea sp@(12),sp | depilage
! 4766: rts
! 4767:
! 4768: #===================================================================#
! 4769: # #
! 4770: # Division : entier / reel = reel #
! 4771: # #
! 4772: # entree : a7@(4) pointe sur i2 de type I #
! 4773: # a7@(8) pointe sur r1 de type R #
! 4774: # sortie : d0 pointe sur i2 / r1 de type R (zone creee) #
! 4775: # #
! 4776: #===================================================================#
! 4777:
! 4778: _divir: link a6,#-32 | var. locales pour appel dvrr
! 4779: moveml a2-a3,sp@-
! 4780: movl a6@(12),a1 | a1 pointe sur r1
! 4781: tstb a1@(4)
! 4782: bne 1$
! 4783: | ici r1 = 0
! 4784: movl #diver5,sp@-
! 4785: jsr _pari_err
! 4786: | ici r1 <> 0
! 4787: 1$: movl a6@(8),a2 | a2 pointe sur i2
! 4788: tstb a2@(4)
! 4789: bne 2$
! 4790: | ici i2 = 0
! 4791: movl _gzero,d0
! 4792: bra divirf
! 4793: 2$: moveq #0,d0 | ici i2 et r1 <> 0
! 4794: movw a1@(2),d0 | d0.w contient l1
! 4795: bsr getr | allocation pour resultat
! 4796: movl a0,a3
! 4797: addqw #1,d0
! 4798: bsr getr | allocation pour conversion i2 type R
! 4799: movl a0,a6@(-16) | sauvegarde adr. du transforme i2'
! 4800: movl a0,sp@-
! 4801: movl a2,sp@-
! 4802: bsr _affir
! 4803: addql #8,sp
! 4804: movl a0,a2 | a2 pointe sur i2'
! 4805: movl a3,a0 | a0 pointe sur resultat
! 4806: bsr dvrr
! 4807: movl a6@(-16),a0
! 4808: bsr giv | desallouer i2'
! 4809: movl a3,d0
! 4810: divirf: moveml sp@+,a2-a3
! 4811: unlk a6
! 4812: rts
! 4813:
! 4814: #===================================================================#
! 4815: # #
! 4816: # Division : reel / entier court = reel #
! 4817: # #
! 4818: # entree : a7@(4) pointe sur r2 de type R #
! 4819: # a7@(8) pointe sur s1 de type S #
! 4820: # sortie : d0 pointe sur r2 / s1 de type R (zone creee) #
! 4821: # #
! 4822: #===================================================================#
! 4823:
! 4824: _divrs: link a6,#0
! 4825: moveml d2-d6/a2,sp@-
! 4826: movl a6@(12),d1 | d1 recoit s1 diviseur
! 4827: bne 1$
! 4828: | ici s1 = 0
! 4829: movl #diver6,sp@-
! 4830: jsr _pari_err
! 4831: | ici diviseur s1 <> 0
! 4832: 1$: movl a6@(8),a2 | a2 pointe sur r2 dividende
! 4833: tstb a2@(4)
! 4834: bne 2$
! 4835: | ici r2 = 0
! 4836: moveq #3,d0
! 4837: bsr getr
! 4838: tstl d1
! 4839: bpl 11$
! 4840: negl d1
! 4841: 11$: bfffo d1{#0:#0},d0
! 4842: addl a2@(4),d0
! 4843: subl #31,d0
! 4844: bmi 9$
! 4845: movl d0,a0@(4)
! 4846: clrl a0@(8)
! 4847: bra divrsf
! 4848: | ici r2 et s1 <> 0
! 4849: 2$: movw a2@(2),d0 | d0 recoit l2
! 4850: bsr getr | allocation pour resultat
! 4851: movb a2@(4),a0@(4) | signe de r2
! 4852: tstl d1
! 4853: bpl 3$
! 4854: negl d1 | d1 recoit |s1| <= 2^31
! 4855: | s1 est tjrs <= 1er mot mantisse
! 4856: | le 1er quotient partiel est non nul
! 4857: negb a0@(4)
! 4858: 3$: movl a0,a1
! 4859: addql #8,a1
! 4860: addql #8,a2
! 4861: subqw #3,d0 | d0 recoit L2-1 compteur
! 4862: movl d0,d2 | conserve dans d2
! 4863: moveq #0,d3 | 1er reste
! 4864: 4$: movl a2@+,d4
! 4865: divul d1,d3:d4
! 4866: movl d4,a1@+
! 4867: dbra d0,4$ | boucle de division
! 4868:
! 4869: movl a0@(8),d0 | resultat normalise ?
! 4870: bpl 10$
! 4871: moveq #0,d1 | ici normalise ; nb shift = 0
! 4872: bra 5$
! 4873: | ici il faut normaliser
! 4874:
! 4875: 10$: moveq #0,d4
! 4876: divul d1,d3:d4 | traite dernier reste: quotient
! 4877: | a recuperer par le shift
! 4878: bfffo d0{#0:#0},d1 | nb de shift dans d1
! 4879: lsll d1,d0 | shift 1er lg mot d0
! 4880: movl a0,a1
! 4881: addql #8,a1
! 4882: moveq #1,d6
! 4883: lsll d1,d6
! 4884: subql #1,d6 | d6 masque de shift
! 4885: bra 7$
! 4886: 6$: movl a1@(4),d3
! 4887: roll d1,d3
! 4888: movl d3,d5
! 4889: andl d6,d3
! 4890: addl d3,d0
! 4891: movl d0,a1@+
! 4892: subl d3,d5
! 4893: movl d5,d0
! 4894: 7$: dbra d2,6$
! 4895: roll d1,d4 | shifter dernier quotient
! 4896: andl d6,d4
! 4897: addl d4,d0
! 4898: movl d0,a1@
! 4899: 5$: movl a6@(8),a2 | a2 pointe sur r2 dividende
! 4900: movl a2@(4),d2
! 4901: andl #0xffffff,d2 | exposant biaise de r2
! 4902: subl d1,d2 | exposant resultat
! 4903: bpl 8$
! 4904: | ici underflow
! 4905: 9$: movl #diver7,sp@-
! 4906: jsr _pari_err
! 4907: 8$: movw d2,a0@(6)
! 4908: swap d2
! 4909: movb d2,a0@(5) | range exposant
! 4910: divrsf: movl a0,d0
! 4911: moveml sp@+,d2-d6/a2
! 4912: unlk a6
! 4913: rts
! 4914:
! 4915:
! 4916: #===================================================================#
! 4917: # #
! 4918: # Division : reel / entier = reel #
! 4919: # #
! 4920: # entree : a7@(4) pointe sur r2 de type R #
! 4921: # a7@(8) pointe sur i1 de type I #
! 4922: # sortie : d0 pointe sur r2 / i1 de type R (zone creee) #
! 4923: # #
! 4924: #===================================================================#
! 4925:
! 4926: _divri: link a6,#-32 | var. locales pour appel dvrr
! 4927: moveml d2-d3/a2-a3,sp@-
! 4928: movl a6@(12),a1 | a1 pointe sur le diviseur i1
! 4929: tstb a1@(4)
! 4930: bne 1$
! 4931: | ici i1 = 0
! 4932: movl #diver8,sp@-
! 4933: jsr _pari_err
! 4934: | ici i1 <> 0
! 4935: 1$: movl a6@(8),a2 | a2 pointe sur le dividende r2
! 4936: tstb a2@(4)
! 4937: bne 2$
! 4938: | ici r2 = 0
! 4939: moveq #3,d0
! 4940: bsr getr
! 4941: movw a1@(6),d0
! 4942: lsll #5,d0
! 4943: bfffo a1@(8){#0:#0},d1
! 4944: addl a2@(4),d1
! 4945: addl #65,d1
! 4946: subl d0,d1
! 4947: bpl 3$
! 4948: movl #diver12,sp@- | underflow R/I avec R = 0
! 4949: jsr _pari_err
! 4950: 3$: movl d1,a0@(4)
! 4951: clrl a0@(8)
! 4952: movl a0,d0
! 4953: bra divrif
! 4954: | ici r2 et i1 <> 0
! 4955: 2$: moveq #0,d0
! 4956: movw a2@(2),d0
! 4957: bsr getr | allocation pour resultat
! 4958: movl _avma,a3 | eviter le chevauchement.
! 4959: subql #8,a3
! 4960: movl a3,_avma
! 4961: movl #2,a3@ | Hack pour que giv rende ceci
! 4962: movl a0,a3 | sauvegarde adr. resultat
! 4963: addqw #1,d0
! 4964: bsr getr | allocation pour conversion i1 type R
! 4965: movl a0,a6@(-16) | sauvegarde adr. copie
! 4966: movl a0,sp@-
! 4967: movl a1,sp@-
! 4968: bsr _affir
! 4969: addql #8,sp
! 4970: movl a0,a1 | a1 pointe sur copie i1
! 4971: movl a3,a0 | a0 pointe sur resultat
! 4972: bsr dvrr
! 4973: movl a6@(-16),a0
! 4974: bsr giv | desallouer copie
! 4975: movl a3,d0
! 4976: divrif: moveml sp@+,d2-d3/a2-a3
! 4977: unlk a6
! 4978: rts
! 4979:
! 4980: #===================================================================#
! 4981: # #
! 4982: # Division : reel / reel = reel #
! 4983: # #
! 4984: # entree : a7@(4) pointe sur r2 de type R #
! 4985: # a7@(8) pointe sur r1 de type R #
! 4986: # sortie : d0 pointe sur r2 / r1 de type R (zone creee) #
! 4987: # precision : L = inf ( L1 , L2 ) #
! 4988: # #
! 4989: #===================================================================#
! 4990:
! 4991: _divrr: link a6,#-32 | var. locales pour appel dvrr
! 4992: movl a2,sp@-
! 4993: movl a6@(12),a1 | a1 pointe sur r1=y diviseur
! 4994: movl a6@(8),a2 | a2 pointe sur r2=x dividende
! 4995: tstb a1@(4) | r1 = 0 ?
! 4996: bne 1$
! 4997: | ici r1 = 0
! 4998: movl #diver9,sp@-
! 4999: jsr _pari_err
! 5000: 1$: tstb a2@(4) | r2 = 0 ?
! 5001: bne 3$
! 5002: | ici r2=0, r1<>0 : resultat nul
! 5003: moveq #3,d0
! 5004: bsr getr
! 5005: movl a1@(4),d0
! 5006: andl #0xffffff,d0 | exposant de r1
! 5007: subl a2@(4),d0
! 5008: negl d0
! 5009: addl #0x800000,d0
! 5010: cmpl #0x1000000,d0
! 5011: bcs 4$
! 5012: movl #diver11,sp@- | debordement r/r
! 5013: jsr _pari_err
! 5014: 4$: tstl d0
! 5015: bgt 5$
! 5016: movl #diver10,sp@- | underflow r/r
! 5017: jsr _pari_err
! 5018: 5$: movl d0,a0@(4)
! 5019: clrl a0@(8)
! 5020: bra divrrf
! 5021: 3$: movw a1@(2),d0
! 5022: cmpw a2@(2),d0
! 5023: bls 2$
! 5024: movw a2@(2),d0 | d0 recoit l=inf(l1,l2)
! 5025: 2$: bsr getr
! 5026: bsr dvrr | effectuer la division !
! 5027: divrrf: movl a0,d0
! 5028: movl sp@,a2
! 5029: unlk a6
! 5030: rts
! 5031:
! 5032: #===================================================================#
! 5033: # #
! 5034: # module interne de division r/r (pour R/R,R/I,I/R et S/R) #
! 5035: # -------------------------------------------------------- #
! 5036: # entree : a1 et a2 pointent sur 2 reels r1 et r2 #
! 5037: # tous 2 non nuls. #
! 5038: # a0 pointe sur un type reel de longueur l=inf(l1,l2) #
! 5039: # ce module a besoin de variables locales reservees et #
! 5040: # pointees par a6 dans le programme appelant. #
! 5041: # sortie : le quotient r2/r1 est mis a l'addresse initiale a0 #
! 5042: # (qui n'est pas affectee) #
! 5043: #===================================================================#
! 5044:
! 5045: dvrr: moveml d2-d7/a2-a4,sp@-
! 5046: movb a1@(4),d1 | signe de r1
! 5047: movb a2@(4),d2 | signe de r2
! 5048: eorb d2,d1
! 5049: addqb #1,d1
! 5050: movb d1,a6@(-2) | sauvegarde signe resultat
! 5051: movl a2@(4),d2
! 5052: andl #0xffffff,d2
! 5053: movl a1@(4),d1
! 5054: andl #0xffffff,d1
! 5055: subl d1,d2
! 5056: addl #0x800000,d2 | exposant provisoire avec offset
! 5057: movl d2,a6@(-6) | sauvegarde
! 5058:
! 5059: movw a0@(2),d0 | d0.w recoit longueur resultat ( inf(l1,l2) )
! 5060: movw a1@(2),d1
! 5061: cmpw #3,d1 | diviseur de longeur 3 ?
! 5062: bne 5$
! 5063: movl a1@(8),d1
! 5064: movl a2@(8),d3
! 5065: clrl d2
! 5066: cmpw #3,a2@(2)
! 5067: beq 7$
! 5068: movl a2@(12),d2
! 5069: 7$: cmpl d3,d1
! 5070: bls 6$
! 5071: divul d1,d3:d2
! 5072: movl d2,a0@(8)
! 5073: movl a6@(-6),d0 | ici mantisse correcte, soustraire 1 a l'exposant
! 5074: subql #1,d0
! 5075: bra comd2
! 5076: 6$: lsrl #1,d3
! 5077: roxrl #1,d2 | shifter de 1 a droite le quadword
! 5078: divul d1,d3:d2
! 5079: movl d2,a0@(8)
! 5080: movl a6@(-6),d0 | exposant correct
! 5081: bra comd2
! 5082: 5$: subw d0,d1 | flag nombre de mots du diviseur
! 5083: movw d1,a6@(-28) | a sauvegarder.
! 5084: subqw #2,d0
! 5085: movw d0,d7 | d0 et d7 recoit m=inf(l1,l2)-2
! 5086: movw d7,a6@(-12) | d7 sera compt boucle externe
! 5087: movl a0@,a6@(-10) | sauvegarde 1er lg mot code resultat
! 5088: | (on a besoin de toute la place)
! 5089: movw a2@(2),d6
! 5090: subqw #2,d6 | sauvegarde l2-2
! 5091: addql #8,a2 | a2 pointe sur y1 (1er mot dividende
! 5092: | on note y=y1y2...ym le dividende
! 5093: movl a0,a4
! 5094: clrl a4@+
! 5095: 1$: movl a2@+,a4@+ | on recopie m+1 lgmots mantisse de y
! 5096: dbra d0,1$ | precede par un zero
! 5097: cmpw d7,d6 | l2>l1 ?
! 5098: bgt 4$
! 5099: clrl a4@(-4) | Si l2<=l1, y(m+1) n'existe pas
! 5100: | a4 pointe apres y(m+1)
! 5101: 4$: movl a0,a2 | a2 pointe sur y0=0 1er mot dividende
! 5102: addql #8,a1 | a1 pointe sur x1 1er mot diviseur
! 5103: lea a1@(8,d7:w:4),a3| a3 pointe apres x(m+2)
! 5104: movl a3,a6@(-32)
! 5105: movw a6@(-28),d6 | (peut etre n'importe quoi mais va etre
! 5106: bne 2$ | corrige)
! 5107: movl a3@(-8),a6@(-20)
! 5108: clrl a3@(-8)
! 5109: 2$: subqw #1,d6
! 5110: bgt 3$
! 5111: movl a3@(-4),a6@(-24)
! 5112: clrl a3@(-4)
! 5113: 3$: moveq #0,d6 | d6 recoit 0 pour les addx
! 5114:
! 5115: | Boucles de division R/R
! 5116: | d7 compt bcl externe initialise a m
! 5117: | pour trouver q0q1...qm
! 5118: | d0 compt bcl interne initialise
! 5119: | par d7 a chaque tour
! 5120: #...................................................................#
! 5121: dext: movl a1@,d0 | d0 recoit x1 (1er mot diviseur)
! 5122: cmpl a2@,d0 | compare a yi
! 5123: bne 1$
! 5124: movl #-1,d1 | essayer q=2^32-1
! 5125: addl a2@(4),d0
! 5126: bcs 4$
! 5127: movl d0,d2
! 5128: bra 2$
! 5129: 1$: bcc 9$
! 5130:
! 5131: moveml a3-a4/d7,sp@- | le quotient precedent etait trop faible
! 5132: addql #4,a3
! 5133: subxl a3@-,a4@-
! 5134: 10$: subxl a3@-,a4@-
! 5135: dbra d7,10$
! 5136: 11$: addql #1,a4@-
! 5137: beq 11$
! 5138: moveml sp@+,a3-a4/d7
! 5139:
! 5140: 9$: movl a2@,d2 | d2 recoit yi
! 5141: movl a2@(4),d1 | d2:d1 recoit yiy(i+1)
! 5142: divul d0,d2:d1 | d1 recoit q = yiy(i+1) div x1
! 5143: | d2 recoit r = yiy(i+1) mod x1
! 5144: 2$: movl a1@(4),d3 | d3 recoit x2
! 5145: mulul d1,d4:d3 | d4:d3 recoit q*x2
! 5146: subl a2@(8),d3
! 5147: subxl d2,d4 | d4:d3 recoit q*x2-(r,y(i+2))
! 5148: bls 4$
! 5149:
! 5150: 3$: subql #1,d1 | ici q est trop grand : q-1
! 5151: subl a1@(4),d3
! 5152: subxl d0,d4 | correction du reste partiel
! 5153: bhi 3$ | boucler tant que trop
! 5154: | ici q =yiy(i+1)y(i+2) div x1x2 correct
! 5155: | on va calculer le reste partiel
! 5156: 4$: movw d7,d0 | d0 recoit m-i compteur
! 5157: movl a3,a1 | a3,a1 pointent apres y(m+2-i)
! 5158: movl a4,a2 | a4,a2 pointent apres y(m+1)
! 5159: movl a1@-,d2
! 5160: mulul d1,d3:d2 | initialise retenue d3 par
! 5161: subl d2,d2 | poids fort de q*y(m+2-i). d2 et X a 0
! 5162: 5$: movl a1@-,d5
! 5163: mulul d1,d4:d5 | boucle interne de multiplication et
! 5164: addxl d3,d5 | soustraction :
! 5165: addxl d2,d4 | yi...y(m+1) recoit yi...y(m+1)-
! 5166: subl d5,a2@- | q*x1...x(m+1-i)
! 5167: movl d4,d3
! 5168: dbra d0,5$
! 5169: addxl d2,d3
! 5170: subl d3,a2@(-4)
! 5171: bcc 6$
! 5172: | ici carry: q encore 1 de trop
! 5173: subql #1,d1
! 5174: movw d7,d0
! 5175: movl a3,a1
! 5176: movl a4,a2
! 5177: subql #4,a1 | correction sur a1 (car on avait prevu
! 5178: | d'initialiser la retenue)
! 5179: 7$: addxl a1@-,a2@-
! 5180: dbra d0,7$ | boucle de readdition(met reste a jour)
! 5181: 6$: movl d1,a2@(-4) | qi correct ! ranger a la place de xi
! 5182: subql #4,a3 | a3 p. un mot de moins pour bcle suiv.
! 5183: | a3 pointe sur x(m-i+1)
! 5184: bcdf: dbra d7,dext | fin de boucle externe de division
! 5185: #...................................................................#
! 5186: movl a6@(-32),a3
! 5187: movw a6@(-28),d5 | remise eventuelle de xm+1 et xm+2
! 5188: bne 7$
! 5189: movl a6@(-20),a3@(-8)
! 5190: 7$: subqw #1,d5
! 5191: bgt 8$
! 5192: movl a6@(-24),a3@(-4)
! 5193: 8$: movw a6@(-12),d5
! 5194: movw d5,d4 | d4 recoit m
! 5195: 6$: movl a2@-,a2@(4)
! 5196: dbra d5,6$
! 5197: movl a6@(-10),a2@+ | 1er lg mot code;a2 pointe sur q1
! 5198: movl a6@(-6),d0 | exposant biaise
! 5199: movl a2@,d1 | d1 recoit q0=0 ou 1
! 5200: bne 1$
! 5201: | ici q0=0 : mantisse correcte
! 5202: subql #1,d0 | retrancher 1 a l'exposant
! 5203: bra comd2
! 5204: 1$: addql #4,a2 | ici q0=1 : shifter de 1 a droite
! 5205: subqw #1,d4 | d4 recoit m-1
! 5206: asrw #1,d1 | met carry flag
! 5207: 5$: roxrw a2@+
! 5208: roxrw a2@+
! 5209: dbra d4,5$ | boucle de normalisation
! 5210: comd2: cmpl #0x1000000,d0
! 5211: ble 3$
! 5212: movl #diver10,sp@- | underflow
! 5213: jsr _pari_err
! 5214: 3$: bcs 4$
! 5215: movl #diver11,sp@- | overflow
! 5216: jsr _pari_err
! 5217: 4$: movl d0,a0@(4) | range exposant
! 5218: movb a6@(-2),a0@(4) | range signe
! 5219: moveml sp@+,d2-d7/a2-a4
! 5220: dvrrf: rts
! 5221:
! 5222:
! 5223:
! 5224:
! 5225: #*******************************************************************#
! 5226: #*******************************************************************#
! 5227: #** **#
! 5228: #** PROGRAMMES D ' INVERSION **#
! 5229: #** ( programmes par valeurs : le resultat est **#
! 5230: #* mis dans un REEL existant deja ) **#
! 5231: #** **#
! 5232: #*******************************************************************#
! 5233: #*******************************************************************#
! 5234:
! 5235:
! 5236: _mpinvsr:movl sp@(8),sp@-
! 5237: movl sp@(8),sp@-
! 5238: pea 1
! 5239: bsr divssr
! 5240: lea sp@(12),sp
! 5241: rts
! 5242:
! 5243: _mpinvz:cmpb #1,sp@(4)@
! 5244: bne _mpinvrr
! 5245:
! 5246: _mpinvir:movl sp@(8),sp@-
! 5247: movl sp@(8),sp@-
! 5248: pea 1
! 5249: bsr _divsiz
! 5250: lea sp@(12),sp
! 5251: rts
! 5252:
! 5253: _mpinvrr:movl sp@(8),sp@-
! 5254: movl sp@(8),sp@-
! 5255: pea 1
! 5256: bsr _divsrz
! 5257: lea sp@(12),sp
! 5258: rts
! 5259:
! 5260:
! 5261:
! 5262: #*******************************************************************#
! 5263: #*******************************************************************#
! 5264: #** **#
! 5265: #** PROGRAMMES MODULO **#
! 5266: #** **#
! 5267: #*******************************************************************#
! 5268: #*******************************************************************#
! 5269:
! 5270:
! 5271:
! 5272:
! 5273:
! 5274:
! 5275: #===================================================================#
! 5276: # #
! 5277: # Modulo (par valeur) #
! 5278: # #
! 5279: # entree : a7@(4) pointe sur n2 de type I #
! 5280: # a7@(8) pointe sur n1 de type I #
! 5281: # a7@(12) pointe sur n3 de type I #
! 5282: # sortie : la zone pointee par a7@(12) contient le reste de #
! 5283: # la division de n2 par n1 #
! 5284: # compris entre 0 et abs(n1)-1 #
! 5285: # interdit : type S et R #
! 5286: # #
! 5287: #===================================================================#
! 5288:
! 5289: _mpmodz:lea _modii,a0
! 5290: bra mpopi
! 5291:
! 5292: | modulo S mod S = I sinon erreur
! 5293:
! 5294: _modssz:lea _modss,a0
! 5295: bra mpopi
! 5296:
! 5297: | modulo S mod I = I sinon erreur
! 5298:
! 5299: _modsiz:lea _modsi,a0
! 5300: bra mpopi
! 5301:
! 5302: | modulo I mod S = I sinon erreur
! 5303:
! 5304: _modisz:lea _modis,a0
! 5305: bra mpopi
! 5306:
! 5307: | modulo I mod I = I sinon erreur
! 5308:
! 5309: _modiiz:lea _modii,a0
! 5310: bra mpopi
! 5311:
! 5312: #===================================================================#
! 5313: # #
! 5314: # entier court Modulo entier court = entier #
! 5315: # #
! 5316: # entree : a7@(4) contient s2 de type S #
! 5317: # a7@(8) contient s1 de type S #
! 5318: # sortie : d0 pointe sur s2 mod s1 de type I (zone creee) #
! 5319: # compris entre 0 et abs(s1)-1 #
! 5320: # #
! 5321: #===================================================================#
! 5322:
! 5323: _modss: link a6,#0
! 5324: moveml d2-d3,sp@-
! 5325: moveq #0,d3
! 5326: movl a6@(12),d1 | d1.l contient s1
! 5327: bne 1$
! 5328: | ici s1 = 0
! 5329: movl #moder1,sp@-
! 5330: jsr _pari_err
! 5331: | ici s1 <> 0
! 5332: 1$: movl a6@(8),d2 | d2.l contient s2
! 5333: bpl 9$
! 5334: moveq #-1,d3
! 5335: 9$: divsll d1,d3:d2
! 5336: tstl d3
! 5337: bne 2$
! 5338: | ici reste nul
! 5339: 3$: movl _gzero,d0
! 5340: bra modssf
! 5341: | ici reste non nul
! 5342: 2$: bmi 5$
! 5343: | ici reste > 0
! 5344: moveq #3,d0
! 5345: bsr geti
! 5346: movl #0x1000003,a0@(4)
! 5347: movl d3,a0@(8)
! 5348: bra 7$
! 5349: | ici reste < 0
! 5350: 5$: movl a6@(12),sp@-
! 5351: movl d3,sp@-
! 5352: tstl d1
! 5353: bpl 6$
! 5354: | ici s1 < 0
! 5355: bsr _subss
! 5356: addql #8,sp
! 5357: bra modssf
! 5358: | ici s1 > 0
! 5359: 6$: bsr _addss
! 5360: addql #8,sp
! 5361: bra modssf
! 5362: 7$: movl a0,d0
! 5363: modssf: moveml sp@+,d2-d3
! 5364: unlk a6
! 5365: rts
! 5366:
! 5367: #===================================================================#
! 5368: # #
! 5369: # entier court Modulo entier = entier #
! 5370: # #
! 5371: # entree : a7@(4) contient s2 de type S #
! 5372: # a7@(8) ppinte sur i1 de type I #
! 5373: # sortie : d0 pointe sur s2 mod i1 de type I (zone creee) #
! 5374: # compris entre 0 et abs(i1)-1 #
! 5375: # #
! 5376: #===================================================================#
! 5377:
! 5378: _modsi: link a6,#0
! 5379: moveml d2-d3,sp@-
! 5380: movl a6@(12),sp@-
! 5381: movl a6@(8),sp@-
! 5382: bsr _divsi
! 5383: addql #8,sp
! 5384: movl d0,a0
! 5385: bsr giv | desallouer memoire provisoire
! 5386: tstl d1 | tester le reste
! 5387: bne 1$
! 5388: | ici reste nul
! 5389: movl _gzero,d0
! 5390: bra modsif
! 5391: | ici reste non nul
! 5392: 1$: bmi 3$
! 5393: | ici reste > 0
! 5394: movl d1,d3 | d3.l recoit le reste
! 5395: moveq #3,d0
! 5396: bsr geti
! 5397: movl #0x1000003,a0@(4)
! 5398: movl d3,a0@(8)
! 5399: bra 2$
! 5400: | ici reste < 0
! 5401: 3$: movl a6@(12),sp@-
! 5402: movl d1,sp@-
! 5403: movl a6@(12),a1 | a1 pointe sur i1
! 5404: tstb a1@(4)
! 5405: bpl 5$
! 5406: | ici i1 < 0
! 5407: bsr _subsi
! 5408: bra 6$
! 5409: | ici i1 > 0
! 5410: 5$: bsr _addsi
! 5411: 6$: addql #8,sp
! 5412: bra modsif
! 5413: 2$: movl a0,d0
! 5414: modsif: moveml sp@+,d2-d3
! 5415: unlk a6
! 5416: rts
! 5417:
! 5418: #===================================================================#
! 5419: # #
! 5420: # entier Modulo entier court = entier #
! 5421: # #
! 5422: # entree : a7@(4) pointe sur i2 de type I #
! 5423: # a7@(8) contient s1 de type S #
! 5424: # sortie : d0 pointe sur i2 mod s1 de type I (zone creee) #
! 5425: # compris entre 0 et abs(s1)-1 #
! 5426: # #
! 5427: #===================================================================#
! 5428:
! 5429: _modis: link a6,#0
! 5430: moveml d2-d3,sp@-
! 5431: movl a6@(12),sp@-
! 5432: movl a6@(8),sp@-
! 5433: bsr _divis
! 5434: addql #8,sp
! 5435: movl d0,a0
! 5436: bsr giv
! 5437: tstl d1
! 5438: bne 1$
! 5439: | ici reste nul
! 5440: movl _gzero,d0
! 5441: bra modisf
! 5442: | ici reste non nul
! 5443: 1$: bmi 3$
! 5444: | ici reste > 0
! 5445: movl d1,d3
! 5446: moveq #3,d0
! 5447: bsr geti
! 5448: movl #0x1000003,a0@(4)
! 5449: movl d3,a0@(8)
! 5450: bra 2$
! 5451: | ici reste < 0
! 5452: 3$: movl a6@(12),sp@-
! 5453: movl d1,sp@-
! 5454: movl a6@(12),d1 | d1.l contient s1
! 5455: bpl 5$
! 5456: bsr _subss
! 5457: bra 6$
! 5458: 5$: bsr _addss
! 5459: 6$: addql #8,sp
! 5460: bra modisf
! 5461: 2$: movl a0,d0
! 5462: modisf: moveml sp@+,d2-d3
! 5463: unlk a6
! 5464: rts
! 5465:
! 5466: #===================================================================#
! 5467: # #
! 5468: # entier Modulo entier = entier #
! 5469: # #
! 5470: # entree : a7@(4) pointe sur i2 de type I #
! 5471: # a7@(8) pointe sur i1 de type I #
! 5472: # sortie : d0 pointe sur i2 mod i1 de type I #
! 5473: # compris entre 0 et abs(i1)-1(zone creee) #
! 5474: # #
! 5475: #===================================================================#
! 5476:
! 5477: _modii: link a6,#-4
! 5478: movl #-1,sp@-
! 5479: movl a6@(12),sp@- | empilage adresse i1
! 5480: movl a6@(8),sp@- | empilage adresse i2
! 5481: movl _avma,a6@(-4) | sauvegarde adr. tete pile PARI
! 5482: bsr _asmdvmdii
! 5483: movl d0,a1 | a1 pointe sur resultat
! 5484: tstb a1@(4)
! 5485: bpl modiif
! 5486: | ici reste negatif
! 5487: movl a1,sp@ | empilage adr. du reste
! 5488: tstb a6@(12)@(4) | test signe du modulo
! 5489: bpl 1$
! 5490: bsr _subii
! 5491: bra 2$
! 5492: 1$: bsr _addii
! 5493: 2$: movl sp@+,a1
! 5494: movl _avma,a0
! 5495: movw a0@(2),d0
! 5496: subqw #1,d0
! 5497: movl a6@(-4),a0 | a0 pointe sur pile initiale
! 5498: 3$: movl a1@-,a0@-
! 5499: dbra d0,3$ | ecraser resultat intermediaire
! 5500: movl a0,_avma
! 5501: movl a0,d0 | nouvelle adresse resultat
! 5502: modiif: unlk a6
! 5503: rts
! 5504:
! 5505:
! 5506:
! 5507:
! 5508:
! 5509: #*******************************************************************#
! 5510: #*******************************************************************#
! 5511: #** **#
! 5512: #** PROGRAMMES DE RESTE DES DIVISIONS ENTIERES **#
! 5513: #** **#
! 5514: #*******************************************************************#
! 5515: #*******************************************************************#
! 5516:
! 5517:
! 5518:
! 5519:
! 5520:
! 5521: #===================================================================#
! 5522: # #
! 5523: # Reste (par valeur) #
! 5524: # #
! 5525: # entree : a7@(4) pointe sur n2 de type I #
! 5526: # a7@(8) pointe sur n1 de type I #
! 5527: # a7@(12) pointe sur n3 de type I #
! 5528: # sortie : la zone pointee par a7@(12) contient le reste de #
! 5529: # la division de n2 par n1 (du signe du dividende) #
! 5530: # interdit : type S et R #
! 5531: # #
! 5532: #===================================================================#
! 5533:
! 5534: _mpresz:lea _resii,a0
! 5535: bra mpopi
! 5536:
! 5537: | reste de S/S = I sinon erreur
! 5538:
! 5539: _resssz:lea _resss,a0
! 5540: bra mpopi
! 5541:
! 5542: | reste de S/I = I sinon erreur
! 5543:
! 5544: _ressiz:lea _ressi,a0
! 5545: bra mpopi
! 5546:
! 5547: | reste de I/S = I sinon erreur
! 5548:
! 5549: _resisz:lea _resis,a0
! 5550: bra mpopi
! 5551:
! 5552: | reste de I/I = I sinon erreur
! 5553:
! 5554: _resiiz:lea _resii,a0
! 5555: bra mpopi
! 5556:
! 5557: #===================================================================#
! 5558: # #
! 5559: # Reste : entier court / entier court = entier #
! 5560: # #
! 5561: # entree : a7@(4) contient s2 de type S #
! 5562: # a7@(8) contient s1 de type S #
! 5563: # sortie : d0 pointe sur le reste de la division s2 / s1 #
! 5564: # de type I (zone creee) #
! 5565: # Le reste est du signe du dividende #
! 5566: # #
! 5567: #===================================================================#
! 5568:
! 5569: _resss: link a6,#0
! 5570: moveml d2-d3,sp@-
! 5571: moveq #0,d3
! 5572: movl a6@(12),d1 | d1.l contient le diviseur s1
! 5573: bne 1$
! 5574: | ici s1 = 0
! 5575: movl #reser1,sp@-
! 5576: jsr _pari_err
! 5577: | ici s1 <> 0
! 5578: 1$: movl a6@(8),d2 | d2.l contient s2
! 5579: bpl 9$
! 5580: moveq #-1,d3
! 5581: 9$: divsll d1,d3:d2
! 5582: tstl d3
! 5583: bne 2$
! 5584: | ici reste nul
! 5585: movl _gzero,d0
! 5586: bra resssg
! 5587: | ici reste non nul
! 5588: 2$: moveq #3,d0
! 5589: bsr geti
! 5590: movl #0x1000003,a0@(4)
! 5591: tstl d3
! 5592: bpl 3$
! 5593: negl d3
! 5594: movb #-1,a0@(4)
! 5595: 3$: movl d3,a0@(8)
! 5596: resssf: movl a0,d0
! 5597: resssg: moveml sp@+,d2-d3
! 5598: unlk a6
! 5599: rts
! 5600:
! 5601: #===================================================================#
! 5602: # #
! 5603: # Reste : entier court / entier = entier #
! 5604: # #
! 5605: # entree : a7@(4) contient s2 de type S #
! 5606: # a7@(8) pointe sur i1 de type I #
! 5607: # sortie : d0 pointe sur le reste de la division s2 / i1 #
! 5608: # de type I (zone creee) #
! 5609: # Le reste est du signe du dividende #
! 5610: # #
! 5611: #===================================================================#
! 5612:
! 5613: _ressi: movl sp@(8),sp@- | empilage adr. i1
! 5614: movl sp@(8),sp@- | empilage s2
! 5615: bsr _divsi
! 5616: movl d0,a0 | a0 pointe sur resultat prov.
! 5617: bsr giv
! 5618: tstl d1 | d1.l contient le reste
! 5619: bne 1$
! 5620: | ici reste nul
! 5621: movl _gzero,d0
! 5622: bra ressig
! 5623: | ici reste non nul
! 5624: 1$: moveq #3,d0
! 5625: bsr geti
! 5626: movl #0x1000003,a0@(4)
! 5627: tstl d1
! 5628: bpl 2$
! 5629: negl d1
! 5630: movb #-1,a0@(4)
! 5631: 2$: movl d1,a0@(8)
! 5632: ressif: movl a0,d0
! 5633: ressig: addql #8,sp
! 5634: rts
! 5635:
! 5636: #===================================================================#
! 5637: # #
! 5638: # Reste : entier / entier court = entier #
! 5639: # #
! 5640: # entree : a7@(4) pointe sur i2 de type I #
! 5641: # a7@(8) contient s1 de type S #
! 5642: # sortie : d0 pointe sur le reste de la division i2 / s1 #
! 5643: # (zone creee) #
! 5644: # Le reste est du signe du dividende #
! 5645: # #
! 5646: #===================================================================#
! 5647:
! 5648: _resis: movl sp@(8),sp@- | empilage s1
! 5649: movl sp@(8),sp@- | empilage adr.i2
! 5650: bsr _divis
! 5651: movl d0,a0
! 5652: bsr giv | desallouer memoire provisoire
! 5653: tstl d1 | le reste est dans d1.l
! 5654: bne 1$
! 5655: | ici reste nul
! 5656: movl _gzero,d0
! 5657: bra resisg
! 5658: | ici reste non nul
! 5659: 1$: moveq #3,d0
! 5660: bsr geti
! 5661: movl #0x1000003,a0@(4)
! 5662: tstl d1
! 5663: bpl 2$
! 5664: negl d1
! 5665: movb #-1,a0@(4)
! 5666: 2$: movl d1,a0@(8)
! 5667: resisf: movl a0,d0
! 5668: resisg: addql #8,sp
! 5669: rts
! 5670:
! 5671: #===================================================================#
! 5672: # #
! 5673: # Reste : entier / entier = entier #
! 5674: # #
! 5675: # entree : a7@(4) pointe sur i2 de type I #
! 5676: # a7@(8) pointe sur i1 de type I #
! 5677: # sortie : d0 pointe sur le reste de la division i2 / i1 #
! 5678: # de type I (zone creee) #
! 5679: # ( du signe du dividende) #
! 5680: # #
! 5681: #===================================================================#
! 5682:
! 5683: _resii: movl #-1,sp@-
! 5684: movl sp@(12),sp@-
! 5685: movl sp@(12),sp@-
! 5686: bsr _asmdvmdii
! 5687: lea sp@(12),sp
! 5688: rts
! 5689:
! 5690: #===================================================================#
! 5691: # #
! 5692: # Operations par valeur #
! 5693: # #
! 5694: # entree : a7@(4) contient n2 de type S ou pointe sur n2 #
! 5695: # de type I ou R #
! 5696: # a7@(8) contient n1 de type S ou pointe sur n1 #
! 5697: # de type I ou R #
! 5698: # a7@(12) pointe sur n3 de type I ou R #
! 5699: # sortie : la zone pointee par a7@(12) contient n2 op n1 #
! 5700: # remarque : les erreurs de type sont detectees dans l' #
! 5701: # affectation du resultat #
! 5702: # #
! 5703: #===================================================================#
! 5704:
! 5705: | operation a trois operandes
! 5706: | les trois operandes sont de type I
! 5707:
! 5708: mpariz: movb sp@(12)@,d0
! 5709: addb sp@(8)@,d0
! 5710: addb sp@(4)@,d0
! 5711: cmpb #3,d0
! 5712: beq mpopz
! 5713: movl #arier1,sp@-
! 5714: jsr _pari_err
! 5715:
! 5716: | le troisieme operande est de type I
! 5717:
! 5718: mpopi: cmpb #1,sp@(12)@
! 5719: beq mpopz
! 5720: movl #arier2,sp@-
! 5721: jsr _pari_err
! 5722: | operation quelconque
! 5723:
! 5724: mpopz: movl sp@(8),sp@- | 2eme operande
! 5725: movl sp@(8),sp@- | 1er operande
! 5726: jsr a0@
! 5727: movl sp@(20),sp@(4) | 3eme operande
! 5728: movl d0,sp@ | resultat operation
! 5729: jsr _mpaff
! 5730: addql #8,sp
! 5731: movl d0,a0
! 5732: bra giv
! 5733:
! 5734: | operation a quatre operandes
! 5735: | avec deux resultats de type I
! 5736:
! 5737: mpopii: movb sp@(16)@,d0
! 5738: addb sp@(12)@,d0
! 5739: cmpb #2,d0
! 5740: beq mpopz2
! 5741: movl #arier2,sp@-
! 5742: jsr _pari_err
! 5743:
! 5744: | operation a quatre operande
! 5745:
! 5746: mpopz2: link a6,#-8
! 5747: movl _avma,a6@(-8)
! 5748: pea a6@(-4)
! 5749: movl a6@(12),sp@- | 2eme operande
! 5750: movl a6@(8),sp@- | 1er operande
! 5751: jsr a0@
! 5752: addql #4,sp
! 5753: movl a6@(-4),sp@
! 5754: movl a6@(20),sp@(4)
! 5755: bsr _mpaff | rangement 2 eme resultat
! 5756: movl d0,sp@
! 5757: movl a6@(16),sp@(4)
! 5758: bsr _mpaff | rangement 1 er resultat
! 5759: addql #8,sp
! 5760: movl a6@(-8),_avma
! 5761: unlk a6
! 5762: rts
! 5763:
! 5764:
! 5765:
! 5766:
! 5767:
! 5768: #*******************************************************************#
! 5769: #*******************************************************************#
! 5770: #** **#
! 5771: #** PROGRAMMES PAR VALEUR UTILISES POUR LA LECTURE-ECRITURE **#
! 5772: #** **#
! 5773: #*******************************************************************#
! 5774: #*******************************************************************#
! 5775:
! 5776:
! 5777:
! 5778:
! 5779:
! 5780: #===================================================================#
! 5781: # #
! 5782: # Multiplication par valeur : entier court * entier = entier #
! 5783: # #
! 5784: # entree : a7@(4) contient s2 de type S #
! 5785: # a7@(8) pointe sur i1 de type I #
! 5786: # a7@(12) pointe sur i3 de type I #
! 5787: # sortie : i3 pointe sur s2 * i1 #
! 5788: # #
! 5789: #===================================================================#
! 5790:
! 5791: _mulsii:movl sp@(8),sp@-
! 5792: movl sp@(8),sp@-
! 5793: bsr _mulsi
! 5794: movl sp@(20),sp@(4)
! 5795: movl d0,sp@
! 5796: bsr _affii
! 5797: movl sp@,a0
! 5798: addql #8,sp
! 5799: bra giv
! 5800:
! 5801: #===================================================================#
! 5802: # #
! 5803: # Addition par valeur : entier court + entier = entier #
! 5804: # #
! 5805: # entree : a7@(4) contient s2 de type S #
! 5806: # a7@(8) pointe sur i1 de type I #
! 5807: # a7@(12) pointe sur i3 de type I #
! 5808: # sortie : i3 pointe sur s2 + i1 #
! 5809: # #
! 5810: #===================================================================#
! 5811:
! 5812: _addsii:movl sp@(8),sp@-
! 5813: movl sp@(8),sp@-
! 5814: bsr _addsi
! 5815: movl sp@(20),sp@(4)
! 5816: movl d0,sp@
! 5817: bsr _affii
! 5818: movl sp@,a0
! 5819: addql #8,sp
! 5820: bra giv
! 5821:
! 5822: #===================================================================#
! 5823: # #
! 5824: # division I / S = I #
! 5825: # #
! 5826: # entree: a7@(4) pointe sur i2, a7@(8) contient s1 #
! 5827: # a7@(12) pointe sur un type I #
! 5828: # sortie: a7@(12) pointe sur i2 div s1 #
! 5829: # d1 contient i2 mod s1 #
! 5830: # #
! 5831: #===================================================================#
! 5832:
! 5833: _divisii:movl sp@(8),sp@-
! 5834: movl sp@(8),sp@-
! 5835: bsr _divis
! 5836: movl sp@(20),sp@(4)
! 5837: movl d0,sp@
! 5838: bsr _affii
! 5839: movl sp@,a0
! 5840: addql #8,sp
! 5841: bra giv