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