********************************************************************* *===================================================================* ** ** *= =* ** ** *= oooooooooo ooooo oooooooooo ooooo =* ** ooooooooooo ooooooooo ooooooooooo ooo ** ** ooo ooo ooo ooo ooo ooo ooo ** *= ooo ooo ooo ooo ooo ooo ooo =* ** ooooooooooo ooooooooooo oooooooooo ooo ** *= oooooooooo ooooooooooo ooooooooooo ooo =* ** ooo ooo ooo ooo ooo ooo ** *= ooo ooo ooo ooo ooo ooo =* ** ooooo ooooo ooooo ooooo ooooo ooooo ** ** ** *= =* ** version numero 2 ** ** ** *= commentee =* ** ** *= fichier cree le 22 sept. 1987 =* ** ** *= par =* ** ** *= christian batut , henri cohen , michel olivier =* ** ** *= """""""""""""""""""""""""""""""""""""""""""""" =* ** ** ** ** *===================================================================* ********************************************************************* *-------------------------------------------------------------------* * * * Notations : * * T = type ( S , I , ou R ). * * R = type reel. * * S = type entier court ( long du C). * * P = p-adique. * * * * L = longueur de la mantisse pour un reel ; * * longueur de la mantisse effective pour un entier* * l = longueur totale du nombre avec codage. * * le= longueur effective totale de l'entier avec code * * on doit avoir : l <= 2^15-1. * * * * exp = exposant non biaise d'un reel. * * fexp= exposant biaise ( fexp = exp + 2^23 ). * * on doit avoir : -2^23 <= exp < 2^23 * * fvalp=valuation p-adique biaisee d'un p-adique. * * ( fvalp = valuation + 2^15 ) * * * *-------------------------------------------------------------------* *-------------------------------------------------------------------* * * * Conventions : * * Tous les sous programmes creent la place necessaire * * pour stocker le resultat , a l'exception des * * programmes d'affectation et d'echange , ainsi que * * des programmes dont le nom se termine par la lettre * * "z" . On entre dans ces derniers avec une zone creee* * dans la pile PARI ou le resultat est range. * * * * Le nombre reel 0 s'ecrit avec mantisse non * * significative;le deuxieme lgmot code contient * * -32*L + (2^23) ou L est la longueur de la mantisse * * * * Les registres a0,a1,d0,d1 sont en general utilises * * par les programmes et ne sont pas restaures a leurs * * valeurs d'entree.Tous les autres sont sauvegardes. * * * * Les objets utilises par PARI sont crees dans une * * pile dite dans la suite "pile PARI",pointee par * * _avma. * * * *-------------------------------------------------------------------* #define affer1 1 #define affer2 2 #define affer3 3 #define affer4 4 #define affer5 5 #define exger1 6 #define exger2 7 #define shier1 8 #define shier2 9 #define truer1 10 #define truer2 11 #define adder1 12 #define adder2 13 #define adder3 14 #define adder4 15 #define adder5 16 #define muler1 17 #define muler2 18 #define muler3 19 #define muler4 20 #define muler5 21 #define muler6 22 #define diver1 23 #define diver2 24 #define diver3 25 #define diver4 26 #define diver5 27 #define diver6 28 #define diver7 29 #define diver8 30 #define diver9 31 #define diver10 32 #define diver11 33 #define diver12 34 #define divzer1 35 #define dvmer1 36 #define dvmzer1 37 #define moder1 38 #define modzer1 39 #define reser1 40 #define reszer1 41 #define arier1 42 #define arier2 43 #define errpile 44 #define rtodber 45 #define gerper 46 .text .globl _expi .globl _cget .globl _cgetg .globl _cgeti .globl _cgetr .globl _cgiv .globl _gerepile .globl _mpaff .globl _affsz .globl _affsi .globl _affsr .globl _affii .globl _affir .globl _affrs .globl _affri .globl _affrr .globl _stoi .globl _itos .globl _mpneg .globl _mpnegz .globl _negs .globl _negi .globl _negr .globl _mpabs .globl _mpabsz .globl _abss .globl _absi .globl _absr .globl _mptrunc .globl _mptruncz .globl _mpent .globl _mpentz .globl _mpexg .globl _vals .globl _vali .globl _mpshift .globl _mpshiftz .globl _shifts .globl _shifti .globl _shiftr .globl _mpcmp .globl _cmpss .globl _cmpsi .globl _cmpsr .globl _cmpis .globl _cmpii .globl _cmpir .globl _cmprs .globl _cmpri .globl _cmprr .globl _mpadd .globl _addss .globl _addsi .globl _addsr .globl _addii .globl _addir .globl _addrr .globl _mpaddz .globl _addssz .globl _addsiz .globl _addsrz .globl _addiiz .globl _addirz .globl _addrrz .globl _mpsub .globl _subss .globl _subsi .globl _subsr .globl _subis .globl _subii .globl _subir .globl _subrs .globl _subri .globl _subrr .globl _mpsubz .globl _subssz .globl _subsiz .globl _subsrz .globl _subisz .globl _subiiz .globl _subirz .globl _subrsz .globl _subriz .globl _subrrz .globl _mpmul .globl _mulss .globl _mulmodll .globl _mulsi .globl _mulsr .globl _mulii .globl _mulir .globl _mulrr .globl _mpmulz .globl _mulssz .globl _mulsiz .globl _mulsrz .globl _muliiz .globl _mulirz .globl _mulrrz .globl _dvmdss .globl _dvmdsi .globl _dvmdis .globl _dvmdii .globl _mpdvmdz .globl _dvmdssz .globl _dvmdsiz .globl _dvmdisz .globl _dvmdiiz .globl _mpdiv .globl _divss .globl _divsi .globl _divsr .globl _divis .globl _divii .globl _divir .globl _divrs .globl _divri .globl _divrr .globl _mpdivis .globl _divise .globl _mpdivz .globl _divssz .globl _divsiz .globl _divsrz .globl _divisz .globl _diviiz .globl _divirz .globl _divrsz .globl _divriz .globl _divrrz .globl _mpinvz .globl _mpinvsr .globl _mpinvir .globl _mpinvrr .globl _modss .globl _modsi .globl _modis .globl _modii .globl _mpmodz .globl _modssz .globl _modsiz .globl _modisz .globl _modiiz .globl _resss .globl _ressi .globl _resis .globl _resii .globl _mpresz .globl _resssz .globl _ressiz .globl _resisz .globl _resiiz .globl _convi .globl _confrac .globl _addsii .globl _mulsii .globl _divisii ********************************************************************* ********************************************************************* *** *** *** PROGRAMMES DE GESTION DE LA MEMOIRE PARI *** *** *** ********************************************************************* ********************************************************************* *===================================================================* * * * Allocation memoire dans pile PARI en C * * * * entree : a7@(4) contient la longueur totale a attribuer * * sortie : d0 pointe sur un type I ou R * * d1 et a1 sont inutilises * * * *===================================================================* _cget: move.l 4(sp),d0 bsr.b _get move.l a0,d0 rts _cgetg: move.l 8(sp),d0 ror.l #8,d0 move.w 6(sp),d0 bsr.b _get move.l a0,d0 rts _cgeti: move.l 4(sp),d0 bsr.b _geti move.l a0,d0 rts _cgetr: move.l 4(sp),d0 bsr.b _getr move.l a0,d0 rts *===================================================================* * * * Allocation memoire dans pile PARI * * * * entree : d0.w contient le nombre total de longs mots * * demandes si type I ou R * * sortie : a0 pointe sur la zone allouee ; _avma est mis * * a jour ; message d'erreur si memoire insuffisante ;* * d0 est inchange;d1 et a1 sont sauvegardes. * * remarque : il est interdit de creer des type S dans la pile * * * *===================================================================* _get: move.l d1,-(sp) moveq #0,d1 move.w d0,d1 lsl.l #2,d1 move.l _avma,a0 sub.l d1,a0 cmp.l _bot,a0 bmi.b mnet move.l a0,_avma swap d0 move.b #1,d0 swap d0 move.l d0,(a0) move.l (sp)+,d1 rts _geti: move.l d1,-(sp) moveq #0,d1 move.w d0,d1 lsl.l #2,d1 move.l _avma,a0 sub.l d1,a0 cmp.l _bot,a0 bmi.b mnet move.l a0,_avma move.w #0x101,(a0) move.w d0,2(a0) move.l (sp)+,d1 rts _getr: move.l d1,-(sp) moveq #0,d1 move.w d0,d1 lsl.l #2,d1 move.l _avma,a0 sub.l d1,a0 cmp.l _bot,a0 bmi.b mnet move.l a0,_avma move.w #0x201,(a0) move.w d0,2(a0) move.l (sp)+,d1 rts mnet: move.l #44,-(sp) jsr _err *===================================================================* * * * Desallocation memoire PARI en C * * * * entree : a7@(4) pointe sur un type I ou R * * sortie : la zone occupee est desallouee * * * *===================================================================* _cgiv: move.l 4(sp),a0 *===================================================================* * * * Desallocation memoire PARI * * * * entree : a0@ contient le premier long mot code d'une * * zone memoire a desallouer : uniquement de type * * I ou R * * sortie : avma est mis a jour si necessaire ; ou bien le * * nombre de peres de la zone est decremente. * * a0 pointe sur _avma a jour * * tous les autres registres sont inchanges * * * *===================================================================* _giv: move.l d0,-(sp) cmp.b #0xff,1(a0) beq.b givf cmp.l _avma,a0 beq.b giv1 sub.b #1,1(a0) givf: move.l (sp)+,d0 rts giv1: sub.b #1,1(a0) bne.b givf 1: move.w 2(a0),d0 lea (0,a0,d0.w*4),a0 move.l a0,_avma tst.b 1(a0) beq.b 1b bra.b givf *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~* * * * GESTION DE PILE * * * * Entree : sp(4) et sp(8) contiennent 2 adresses l > p * * sp(12) contient 0 ou une adresse q ;< * * * * Sortie : la zone entre p et l est ecrasee ; * * - la zone entre _avma et p est decalee d'autant ; * * - tous les pointeurs situes dans cette derniere * * zone et qui pointent avant p sont mis a jour * * et q est augmente du decalage . * * ( d0 contient celui ci ou le decalage en octets )* * - de plus si q est non nul la racine pointee par l * * est mise a jour si il y a lieu . * * - _avma est mis a jour ( augmente du decalage ) * * * *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~* _gerepile: movem.l d2-d6/a2-a3,-(sp) move.l _avma,d5 move.l 32(sp),d2 move.l d2,a0 move.l d2,d4 move.l 36(sp),d1 move.l d1,a1 move.l d1,d0 sub.l d0,d2 bhi.b L1000 move.l 40(sp),d0 bra.w 9f L1000: sub.l d5,d1 lsr.l #2,d1 bra.b 2f 1: move.l -(a1),-(a0) 2: dbra d1,1b sub.l #0x10000,d1 bge.b 1b move.l a0,_avma clr.l d3 lea _lontyp,a3 *---------------------------------| mise a jour de la zone recopiee : 3: move.b (a0),d3 move.l (a3,d3.w*4),d1 lea (a0,d1.l*4),a1 move.w 2(a0),d1 move.l a0,a2 lea (a0,d1.w*4),a0 cmp.b #10,d3 bne.b L1301 move.w 6(a2),d6 cmp.w d1,d6 bhi.b 6f lea (a2,d6.w*4),a2 bra.b 4f L1301: move.l a0,a2 subq.l #4,a1 8: addq.l #4,a1 4: cmp.l a2,a1 bcc.b 6f cmp.l (a1),d0 bls.b 5f cmp.l (a1),d5 bhi.b 8b add.l d2,(a1)+ bra.b 4b 5: cmp.l (a1)+,d4 bls.b 4b cmp.l d4,a0 bhi.b 4b move.l #46,-(sp) jsr _err 6: cmp.l d4,a0 bcs.b 3b bne.b 7f tst.l 40(sp) bne.b 3b 7: move.l d0,d1 move.l 40(sp),d0 beq.b L1101 cmp.l d0,d1 bls.b 9f cmp.l d0,d5 bhi.b 9f L1101: add.l d2,d0 9: movem.l (sp)+,d2-d6/a2-a3 rts ********************************************************************* ********************************************************************* *** *** *** EXPOSANT D'UN ENTIER *** *** *** ********************************************************************* ********************************************************************* _expi: move.l 4(sp),a0 moveq #0,d0 move.w 6(a0),d0 subq.l #2,d0 lsl.l #5,d0 move.l 8(a0),d1 bfffo d1{0:32},d1 addq.l #1,d1 sub.l d1,d0 rts ********************************************************************* ********************************************************************* *** *** *** PROGRAMMES D'AFFECTATION OU D'ECHANGE *** *** *** ********************************************************************* ********************************************************************* *===================================================================* * * * Affectation generale n2 --> n1 * * * * entree : a7(4) pointe sur n2 de type I ou R * * a7(8) pointe sur n1 de type I ou R * * sortie : la zone pointee par a7(8) contient n2 * * interdit : n2 ou n1 de type S * * remarques: erreur dans le cas R --> I * * d0,d1,a0,a1 sont inchanges * * * *===================================================================* _mpaff: cmp.b #1,([8,sp]) bne.b 1f cmp.b #1,([4,sp]) beq.b _affii bra.w _affri 1: cmp.b #1,([4,sp]) beq.w _affir bra.w _affrr *-------------------------------------------------------------------* _affsz: cmp.b #2,([4,sp]) beq.w _affsr _affsi: link a6,#0 movem.l d0/a0,-(sp) move.l 8(a6),d0 move.l 12(a6),a0 cmp.w #2,2(a0) bne.b 1f tst.l d0 beq.b 4f move.l #1,-(sp) jsr _err 1: tst.l d0 4: bmi.b 2f bne.b 3f move.l #2,4(a0) bra.b affsif 3: move.l #0x1000003,4(a0) move.l d0,8(a0) bra.b affsif 2: move.l #0xff000003,4(a0) neg.l d0 move.l d0,8(a0) affsif: movem.l (sp)+,d0/a0 unlk a6 rts *-------------------------------------------------------------------* _affii: link a6,#0 movem.l d0/a0-a1,-(sp) move.l 8(a6),a1 move.l 12(a6),a0 cmp.l a0,a1 beq.b affiif move.w 2(a0),d0 cmp.w 6(a1),d0 bcc.b 1f move.l #3,-(sp) jsr _err 1: move.w 6(a1),d0 subq.w #2,d0 addq.l #4,a0 addq.l #4,a1 2: move.l (a1)+,(a0)+ dbra d0,2b affiif: movem.l (sp)+,d0/a0-a1 unlk a6 rts *-------------------------------------------------------------------* _itos: move.l a1,-(sp) move.l 8(sp),a1 cmp.w #3,6(a1) bls.b 1f move.l #2,-(sp) jsr _err 1: beq.b 2f moveq #0,d0 bra.b itosf 2: move.l 8(a1),d0 cmp.l #0x80000000,d0 bcs.b 3f beq.b 4f 5: move.l #2,-(sp) jsr _err 4: tst.b 4(a1) bpl.b 5b bra.b itosf 3: tst.w 4(a1) bpl.b itosf neg.l d0 itosf: move.l (sp)+,a1 rts *-------------------------------------------------------------------* _stoi: move.l 4(sp),d1 bne.b 1f move.l _gzero,d0 rts 1: move.l #3,d0 bsr _geti tst.l d1 bmi.b 2f move.l #0x1000003,4(a0) bra.b 3f 2: move.l #0xff000003,4(a0) neg.l d1 3: move.l d1,8(a0) move.l a0,d0 rts *-----------------------------------------------------------------------* _affsr: link a6,#0 movem.l d0-d1/a0,-(sp) move.l 12(a6),a0 move.l 8(a6),d0 bne.b 1f moveq #0,d0 move.w 2(a0),d0 subq.w #2,d0 lsl.l #5,d0 neg.l d0 add.l #0x800000,d0 move.l d0,4(a0) clr.l 8(a0) bra.b affsrf 1: bpl.b 2f neg.l d0 move.b #0xff,4(a0) bra.b 3f 2: move.b #1,4(a0) 3: bfffo d0{0:32},d1 lsl.l d1,d0 neg.w d1 add.w #31,d1 move.w d1,6(a0) move.b #0x80,5(a0) move.l d0,8(a0) moveq #0,d0 move.w 2(a0),d1 subq.l #3,d1 add.l #12,a0 bra.b 4f 5: move.l d0,(a0)+ 4: dbra d1,5b affsrf: movem.l (sp)+,d0-d1/a0 unlk a6 rts *-------------------------------------------------------------------* _affir: link a6,#0 movem.l d0-d6/a0-a1,-(sp) move.l 8(a6),a1 move.l 12(a6),a0 tst.b 4(a1) bne.b 1f moveq #0,d0 move.w 2(a0),d0 subq.w #2,d0 lsl.l #5,d0 neg.l d0 add.l #0x800000,d0 move.l d0,4(a0) clr.l 8(a0) bra.b _affirf 1: move.l 8(a1),d0 bfffo d0{0:32},d1 lsl.l d1,d0 moveq #0,d2 move.w 6(a1),d2 lsl.l #5,d2 sub.l d1,d2 add.l #0x7fffbf,d2 move.l d2,4(a0) move.b 4(a1),4(a0) move.w 6(a1),d4 subq.w #3,d4 move.w 2(a0),d2 subq.w #3,d2 add.l #12,a1 addq.l #8,a0 moveq #1,d6 lsl.l d1,d6 subq.l #1,d6 sub.w d4,d2 bpl.b 2f add.w d2,d4 bra.b 2f 3: move.l (a1)+,d3 rol.l d1,d3 move.l d3,d5 and.l d6,d3 add.l d3,d0 move.l d0,(a0)+ sub.l d3,d5 move.l d5,d0 2: dbra d4,3b tst.w d2 bmi.b 4f moveq #0,d3 move.l d0,(a0)+ bra.b 5f 6: move.l d3,(a0)+ 5: dbra d2,6b bra.b _affirf 4: move.l (a1)+,d3 rol.l d1,d3 and.l d6,d3 add.l d3,d0 move.l d0,(a0)+ _affirf: movem.l (sp)+,d0-d6/a0-a1 unlk a6 rts *-------------------------------------------------------------------* _affrr: link a6,#0 movem.l d0-d1/a0-a1,-(sp) move.l 8(a6),a1 move.l 12(a6),a0 cmp.l a0,a1 beq.b affrrf tst.b 4(a1) bne.b 6f move.l 4(a1),4(a0) clr.l 8(a0) bra.b affrrf 6: addq.l #4,a0 addq.l #4,a1 move.w -2(a0),d0 move.w -2(a1),d1 cmp.w d0,d1 bhi.b 1f sub.w d1,d0 subq.w #2,d1 3: move.l (a1)+,(a0)+ dbra d1,3b moveq #0,d1 bra.b 2f 4: move.l d1,(a0)+ 2: dbra d0,4b bra.b affrrf 1: subq.w #2,d0 5: move.l (a1)+,(a0)+ dbra d0,5b affrrf: movem.l (sp)+,d0-d1/a0-a1 unlk a6 rts *-------------------------------------------------------------------* _affrs: move.l #4,-(sp) jsr _err *-------------------------------------------------------------------* _affri: move.l #5,-(sp) jsr _err *===================================================================* * * * Echange de deux nombres * * * * entree : a7(4) contient l'adresse d'une zone z2 contemant * * n2 de type I ou R ; a7(8) contient l'adresse d'une* * zone z1 contenant n1 de type I ou R * * sortie : a7(4) contient l'adresse de z2 contenant n1 * * a7(8) contient l'adresse de z1 contenant n2 * * d0,d1,a0,a1 sont sauvegardes * * remarque : message d'erreur si impossible ; type S interdit * * * *===================================================================* _mpexg: link a6,#0 movem.l d0-d4/a0-a2,-(sp) move.l 8(a6),a2 move.l 12(a6),a1 move.b (a2),d2 move.b (a1),d1 cmp.b d1,d2 beq.b 1f move.l #7,-(sp) jsr _err 1: move.l (a1),d3 move.l (a2),d4 cmp.w d3,d4 bne.b 2f subq.w #3,d3 addq.l #4,a1 addq.l #4,a2 6: move.l (a2),d4 move.l (a1),(a2)+ move.l d4,(a1)+ dbra d3,6b bra.b exgf 2: cmp.b #1,d1 bne.b 3f cmp.w d3,d4 ble.b 4f exg a1,a2 exg d3,d4 4: cmp.w 6(a1),d4 bpl.b 5f move.l #6,-(sp) jsr _err 5: move.l d4,d0 bsr _geti move.l a0,-(sp) move.l a2,-(sp) bsr _affii addq.l #8,sp move.l a2,-(sp) move.l a1,-(sp) bsr _affii addq.l #8,sp move.l a1,-(sp) move.l a0,-(sp) bsr _affii addq.l #8,sp bsr _giv bra.b exgf 3: move.l d4,d0 bsr _getr move.l a0,-(sp) move.l a2,-(sp) bsr _affrr addq.l #8,sp move.l a2,-(sp) move.l a1,-(sp) bsr _affrr addq.l #8,sp move.l a1,-(sp) move.l a0,-(sp) bsr _affrr addq.l #8,sp bsr _giv exgf: movem.l (sp)+,d0-d4/a0-a2 unlk a6 rts ********************************************************************* ********************************************************************* *** *** *** PROGRAMMES DE CHANGEMENT DE SIGNE *** *** *** ********************************************************************* ********************************************************************* *===================================================================* * * * Negation generale * * * * entree : a7(4) pointe sur n2 de type I ou R * * sortie : d0 pointe sur n1 de type I ou R * * contenant n1 = -n2 (zone creee) * * interdit : type S * * * *===================================================================* _mpneg: cmp.b #1,([4,sp]) beq.b _negi bra.w _negr *===================================================================* * * * Negation (par valeur) * * * * entree : a7(4) pointe sur n2 de type I ou R * * a7(8) pointe sur n1 de type I ou R * * sortie : la zone pointee par a7(8) contient -n2 * * interdit : type S * * * *===================================================================* _mpnegz: move.l 4(sp),a0 cmp.l 8(sp),a0 bne.b 1f neg.b 4(a0) rts 1: move.l 4(sp),-(sp) bsr _mpneg move.l d0,-(sp) move.l 16(sp),4(sp) bsr _mpaff move.l (sp),a0 addq.l #8,sp bra.w _giv *===================================================================* * * * Negation * * * * entree : a7(4) contient un type S ou pointe sur un * * type I ou R , soit n2 * * sortie : d0 pointe sur un type I ou R ,soit n1=-n2 * * (zone creee) * * * *===================================================================* _negs: move.l 4(sp),d1 bne.b 1f move.l _gzero,d0 rts 1: moveq #3,d0 bsr _geti move.l a0,d0 move.l #0x1000003,4(a0) neg.l d1 bpl.b 2f move.b #0xff,4(a0) neg.l d1 2: move.l d1,8(a0) rts *-------------------------------------------------------------------* _negi: move.l 4(sp),a1 move.w 6(a1),d1 move.l d1,d0 bsr _geti move.l a0,d0 addq.l #4,a0 addq.l #4,a1 subq.w #2,d1 1: move.l (a1)+,(a0)+ dbra d1,1b move.l d0,a0 neg.b 4(a0) rts *-------------------------------------------------------------------* _negr: move.l 4(sp),a1 move.l (a1),d1 move.l d1,d0 bsr _getr move.l a0,d0 addq.l #4,a0 addq.l #4,a1 subq.w #2,d1 1: move.l (a1)+,(a0)+ dbra d1,1b move.l d0,a0 neg.b 4(a0) rts *===================================================================* * * * Valeur absolue generale * * * * entree : a7(4) pointe sur n2 de type I ou R * * sortie : d0 pointe sur n1 de type I ou R avec n1=abs(n2) * * de type I ou R (zone creee) * * interdit : type S * * * *===================================================================* _mpabs: cmp.b #1,([4,sp]) beq.b _absi bra.w _absr *===================================================================* * * * Valeur absolue (par valeur) * * * * entree : a7(4) pointe sur n2 de type I ou R * * a7(8) pointe sur n1 de type I ou R * * sortie : la zone pointee par a7(8) contient abs(n2) * * interdit : type S * * * *===================================================================* _mpabsz: move.l 4(sp),a0 cmp.l 8(sp),a0 bne.b 1f and.b #1,4(a0) rts 1: move.l 4(sp),-(sp) bsr _mpabs move.l d0,-(sp) move.l 16(sp),4(sp) bsr _mpaff move.l (sp),a0 addq.l #8,sp bra.w _giv *===================================================================* * * * Valeur absolue * * * * entree : a7(4) contient ou pointe sur n2 * * sortie : d0 pointe sur i1 ou r1 (zone creee) * * * *===================================================================* _abss: move.l 4(sp),d1 bne.b 1f move.l _gzero,d0 rts 1: moveq #3,d0 bsr _geti move.l a0,d0 move.l #0x1000003,4(a0) tst.l d1 bpl.b 2f neg.l d1 2: move.l d1,8(a0) rts *-------------------------------------------------------------------* _absi: move.l 4(sp),a1 move.w 6(a1),d1 move.w d1,d0 bsr _geti move.l a0,d0 cmp.w #2,d1 bne.b 1f move.l #2,4(a0) bra.b absif 1: move.l #0x1000000,4(a0) move.w d1,6(a0) addq.l #8,a1 addq.l #8,a0 subq.w #3,d1 2: move.l (a1)+,(a0)+ dbra d1,2b absif: rts *-------------------------------------------------------------------* _absr: move.l 4(sp),a1 move.w 2(a1),d1 move.w d1,d0 bsr _getr move.l a0,d0 subq.w #2,d1 addq.l #4,a1 addq.l #4,a0 1: move.l (a1)+,(a0)+ dbra d1,1b move.l d0,a0 tst.b 4(a0) bpl.b absrf neg.b 4(a0) absrf: rts ********************************************************************* ********************************************************************* *** *** *** VALUATION *** *** *** ********************************************************************* ********************************************************************* *===================================================================* * * * Valuation 2-adique d'un entier court ou d'un entier * * * * entree : a7(4) contient s1 de type S ou pointe sur i1 de * * type I * * sortie : d0.l contient k tel que : k>=0 , n1=2^k*n2 , * * avec n2 et 2 premiers entre eux ; si n1=0 , alors * * d0.l contient -1. * * remarque : type R interdit * * * *===================================================================* _vals: link a6,#0 move.l d2,-(sp) moveq #-1,d0 move.l 8(a6),d1 beq.b valsf moveq #0,d0 tst.w d1 bne.b 1f add.l #16,d0 swap d1 1: tst.b d1 bne.b 2f addq.l #8,d0 lsr.l #8,d1 2: move.l d1,d2 and.l #15,d2 bne.b 3f addq.l #4,d0 lsr.l #4,d1 3: move.l d1,d2 and.l #3,d2 bne.b 4f addq.l #2,d0 lsr.l #2,d1 4: btst #0,d1 bne.b valsf addq.l #1,d0 valsf: move.l (sp),d2 unlk a6 rts _vali: link a6,#0 move.l d2,-(sp) move.l 8(a6),a1 moveq #-1,d0 tst.b 4(a1) beq.b valif move.w 6(a1),d1 lea (a1,d1.w*4),a1 move.l #0xffff,d0 5: tst.l -(a1) dbne d0,5b not.w d0 lsl.l #5,d0 move.l (a1),d1 tst.w d1 bne.b 1f add.l #16,d0 swap d1 1: tst.b d1 bne.b 2f addq.l #8,d0 lsr.l #8,d1 2: move.l d1,d2 and.l #15,d2 bne.b 3f addq.l #4,d0 lsr.l #4,d1 3: move.l d1,d2 and.l #3,d2 bne.b 4f addq.l #2,d0 lsr.l #2,d1 4: btst #0,d1 bne.b valif addq.l #1,d0 valif: move.l (sp),d2 unlk a6 rts ********************************************************************* ********************************************************************* *** *** *** PROGRAMMES DE SHIFT *** *** *** ********************************************************************* ********************************************************************* *===================================================================* * * * Shift general * * * * entree : a7(4) pointe sur n2 de type I ou R * * a7(8) contient k = nombre de shifts * * sortie : d0 pointe sur n1 de type I ou R * * contenant n1 = 2^k * n2 (zone creee) * * interdit : type S * * * *===================================================================* _mpshift: cmp.b #1,([4,sp]) beq.w _shifti bra.w _shiftr *===================================================================* * * * Shift (par valeur) * * * * entree : a7(4) pointe sur n2 de type I ou R * * a7(8) contient le nombre de shifts (=k) * * a7(12) pointe sur n1 de type I ou R * * sortie : la zone pointee par a7(12) contient 2^k * n2 * * interdit : type S * * * *===================================================================* _mpshiftz: move.l 4(sp),a0 cmp.l 12(sp),a0 bne.b 1f cmp.b #2,(a0) bne.b 1f move.l 4(a0),d0 and.l #0xffffff,d0 add.l 8(sp),d0 bvs.w shier cmp.l #0x1000000,d0 bcc.w shier tst.l d0 bmi.w shier move.w d0,6(a0) swap d0 move.b d0,5(a0) rts 1: move.l 8(sp),-(sp) move.l 8(sp),-(sp) bsr _mpshift move.l d0,(sp) move.l 20(sp),4(sp) bsr _mpaff move.l (sp),a0 addq.l #8,sp bra.w _giv *===================================================================* * * * Shift d'un entier court = entier * * * * entree : a7(4) contient s2 de type S * * a7(8) contient k = nombre de shifts * * sortie : d0 pointe sur i1 de type I * * avec i1 = 2^k * s2 (zone creee) * * * *===================================================================* _shifts: link a6,#-12 move.l 12(a6),-(sp) move.l 8(a6),d0 bne.b 1f move.l #0x1000002,-12(a6) move.l #2,-8(a6) bra.b 3f 1: move.l #0x1000003,-12(a6) move.l #0x1000003,-8(a6) tst.l d0 bpl.b 2f neg.l d0 move.b #0xff,-8(a6) 2: move.l d0,-4(a6) 3: pea -12(a6) bsr _shifti unlk a6 rts *===================================================================* * * * Shift entier = entier * * * * entree : a7(4) pointe sur i2 de type I * * a7(8) contient k = nombre de shifts * * sortie : d0 pointe sur i1 de type I * * avec i1 = 2^k * i2 (zone creee) * * * *===================================================================* _shifti: link a6,#0 movem.l d2-d7/a2-a3,-(sp) move.l 8(a6),a2 move.l 12(a6),d7 bne.b 1f move.w 2(a2),d0 bsr _geti move.l a0,a3 subq.w #2,d0 addq.l #4,a0 addq.l #4,a2 L2401: move.l (a2)+,(a0)+ dbra d0,L2401 bra.w shiftif 1: tst.b 4(a2) bne.b 2f 6: move.l _gzero,d0 bra.w shiftig 2: moveq #0,d0 move.w 6(a2),d0 cmp.l #1,d7 bne.b 3f move.l 8(a2),d5 btst #31,d5 beq.b 4f addq.w #1,d0 cmp.w #0x8000,d0 bcs.b 4f L1801: move.l #8,-(sp) jsr _err 4: bsr _geti move.l a0,a3 move.w 2(a0),6(a0) move.b 4(a2),4(a0) lea (a0,d0.w*4),a1 lea (a2,d0.w*4),a2 btst #31,d5 beq.b 5f subq.w #4,a2 move.l #1,8(a0) subq.w #1,d0 5: subq.w #3,d0 7: move.l -(a2),d1 roxl.l #1,d1 move.l d1,-(a1) dbra d0,7b bra.w shiftif 3: cmp.l #-1,d7 bne.b 8f cmp.l #1,8(a2) bhi.b 9f subq.w #1,d0 cmp.w #2,d0 beq.w 6b 9: bsr _geti move.l a0,a3 move.b 4(a2),4(a0) move.w 2(a0),6(a0) addq.l #8,a0 addq.l #8,a2 move.w -2(a2),d0 subq.w #3,d0 move.l (a2)+,d1 lsr.l #1,d1 beq.b L1001 move.l d1,(a0)+ bra.b L1001 L1102: move.l (a2)+,d1 roxr.l #1,d1 move.l d1,(a0)+ L1001: dbra d0,L1102 bra.w shiftif 8: tst.l d7 bpl.b L1201 neg.l d7 move.l d7,d4 lsr.l #5,d4 and.l #31,d7 sub.w d4,d0 cmp.w #2,d0 bls.w 2b move.l 8(a2),d4 lsr.l d7,d4 bne.b L1302 subq.w #1,d0 cmp.w #2,d0 beq.w 6b L1302: bsr _geti move.l a0,a3 move.b 4(a2),4(a0) move.w 2(a0),6(a0) lea (a2,d0.w*4),a2 lea (a0,d0.w*4),a1 tst.l d4 beq.b L1401 move.l d4,8(a0) subq.w #3,d0 bra.b L1501 L1401: addq.l #4,a2 subq.w #2,d0 L1501: moveq #-1,d6 lsr.l d7,d6 move.l -(a2),d4 lsr.l d7,d4 bra.b L1601 L1701: move.l -(a2),d2 ror.l d7,d2 move.l d2,d3 and.l d6,d3 sub.l d3,d2 add.l d2,d4 move.l d4,-(a1) move.l d3,d4 L1601: dbra d0,L1701 bra.b shiftif L1201: move.l d7,d4 and.l #31,d7 lsr.l #5,d4 add.l d4,d0 cmp.w #0x7fff,d0 bcc.w L1801 moveq #-1,d6 lsl.l d7,d6 not.l d6 move.l 8(a2),d2 rol.l d7,d2 move.l d2,d3 and.l d6,d3 beq.b L1901 addq.w #1,d0 L1901: bsr _geti move.l a0,a3 move.l 2(a0),6(a0) move.b 4(a2),4(a0) addq.l #8,a0 tst.l d3 beq.b L2001 move.l d3,(a0)+ L2001: sub.l d3,d2 move.l d2,d5 move.w 6(a2),d0 add.l #12,a2 subq.w #3,d0 bra.b L2101 L2201: move.l (a2)+,d2 rol.l d7,d2 move.l d2,d3 and.l d6,d3 sub.l d3,d2 add.l d3,d5 move.l d5,(a0)+ move.l d2,d5 L2101: dbra d0,L2201 move.l d5,(a0)+ moveq #0,d0 bra.b L2301 L2501: move.l d0,(a0)+ L2301: dbra d4,L2501 shiftif: move.l a3,d0 shiftig: movem.l (sp)+,d2-d7/a2-a3 unlk a6 rts *===================================================================* * * * Shift reel = reel * * * * entree : a7(4) pointe sur r2 de type R * * a7(8) contient k = nombre de shifts * * sortie : d0 pointe sur r1 de type R * * avec r1 = 2^k * r2 zone creee) * * * *===================================================================* _shiftr: link a6,#0 movem.l d2/a2-a3,-(sp) move.l 8(a6),a2 move.l 12(a6),d2 bne.b 1f move.w 2(a2),d0 bsr _getr move.l a0,a3 subq.w #2,d0 addq.l #4,a0 addq.l #4,a2 4: move.l (a2)+,(a0)+ dbra d0,4b bra.b shiftrf 1: move.l 4(a2),d1 and.l #0xffffff,d1 add.l d2,d1 bvc.b sh shier: move.l #9,-(sp) jsr _err sh: cmp.l #0x1000000,d1 bcc.b shier tst.l d1 bmi.b shier move.w 2(a2),d0 bsr _getr move.l a0,a3 move.l d1,4(a0) move.b 4(a2),4(a0) addq.l #8,a0 addq.l #8,a2 subq.w #3,d0 5: move.l (a2)+,(a0)+ dbra d0,5b shiftrf: move.l a3,d0 movem.l (sp)+,d2/a2-a3 unlk a6 rts ********************************************************************* ********************************************************************* *** *** *** PROGRAMMES DE PARTIE ENTIERE *** *** *** ********************************************************************* ********************************************************************* *===================================================================* * * * Fausse partie entiere (trunc) * * * * entree : a7(4) pointe sur n1 de type I ou de type R * * sortie : d0 pointe sur i1 de type I (zone creee) * * calcul : si r1 >= 0 , i1 est la partie entiere * * si r1 < 0 , i1 = - Ent (-r1) * * remarque : type S interdit * * * *===================================================================* _mptrunc: link a6,#0 movem.l d2-d6/a2-a4,-(sp) move.l 8(a6),a1 cmp.b #1,(a1) bne.b 5f move.w 6(a1),d0 bsr _geti move.l a0,a4 subq.w #2,d0 addq.l #4,a0 addq.l #4,a1 7: move.l (a1)+,(a0)+ dbra d0,7b bra.w truncf 5: move.l 4(a1),d3 move.l d3,d0 and.l #0xffffff,d0 sub.l #0x800000,d0 bpl.b 1f move.l _gzero,d0 bra.b truncg 1: move.l d0,d2 lsr.l #5,d0 addq.l #3,d0 cmp.l #0x7fff,d0 bls.b 2f move.l #10,-(sp) jsr _err 2: bsr _geti move.l a0,a4 move.w d0,6(a0) move.b 4(a1),4(a0) move.l a0,a3 addq.l #8,a0 addq.l #8,a1 move.w -6(a1),d1 sub.w d0,d1 bpl.b 3f move.l #11,-(sp) jsr _err 3: subq.w #3,d0 addq.b #1,d2 and.b #31,d2 bne.b 4f 8: move.l (a1)+,(a0)+ dbra d0,8b bra.b truncf 4: moveq #1,d6 lsl.l d2,d6 subq.l #1,d6 moveq #0,d5 6: move.l (a1)+,d3 rol.l d2,d3 move.l d3,d4 and.l d6,d4 sub.l d4,d3 add.l d5,d4 move.l d4,(a0)+ move.l d3,d5 dbra d0,6b truncf: move.l a4,d0 truncg: movem.l (sp)+,d2-d6/a2-a4 unlk a6 rts *===================================================================* * * * Fausse partie entiere (par valeur) * * * * entree : a7(4) pointe sur n2 de type I ou R * * a7(8) pointe sur n1 de type I ou R * * sortie : la zone pointee par a7(8) contient trunc(n2) * * interdit : type S * * * *===================================================================* _mptruncz: move.l 4(sp),-(sp) bsr _mptrunc move.l 12(sp),(sp) move.l d0,-(sp) bsr _mpaff move.l d0,a0 addq.l #8,sp bra.w _giv *===================================================================* * * * Partie entiere ( max { n <= x} ) * * * * entree : a7(4) pointe sur n1 de type I ou R * * sortie : d0 pointe sur i1 de type I (zone creee) * * remarque : type S interdit * * * *===================================================================* _mpent: link a6,#0 movem.l d2-d6/a2-a4,-(sp) move.l 8(a6),a1 cmp.b #1,(a1) bne.b 1f move.w 6(a1),d0 bsr _geti move.l a0,a4 subq.w #2,d0 addq.l #4,a0 addq.l #4,a1 6: move.l (a1)+,(a0)+ dbra d0,6b bra.w entf 1: tst.b 4(a1) blt.b 2f move.l 8(a6),-(sp) bsr _mptrunc move.l d0,a4 addq.l #4,sp bra.w entf 2: move.l 4(a1),d3 and.l #0xffffff,d3 sub.l #0x800000,d3 bpl.b 3f moveq #3,d0 bsr _geti move.l a0,a4 move.l #0xff000003,4(a0) move.l #1,8(a0) bra.b entf 3: move.l _avma,a3 move.l 8(a6),-(sp) bsr _mptrunc move.l d0,a4 addq.l #4,sp move.l d3,d1 lsr.l #5,d3 and.l #31,d1 move.l 8(a6),a1 lea (8,a1,d3.l*4),a2 move.l #0x80000000,d6 lsr.l d1,d6 subq.l #1,d6 moveq #0,d2 move.w 2(a1),d2 subq.l #3,d2 sub.l d3,d2 move.l (a2)+,d5 and.l d6,d5 beq.b 4f bra.b 5f 7: tst.l (a2)+ 4: dbne d2,7b bne.b 5f bra.b entf 5: move.l a4,-(sp) move.l #0xffffffff,-(sp) bsr _addsi addq.l #8,sp move.l a4,a1 move.l a3,a4 move.l d0,a0 move.w 2(a0),d0 subq.w #1,d0 8: move.l -(a1),-(a4) dbra d0,8b move.l a4,_avma entf: move.l a4,d0 movem.l (sp)+,d2-d6/a2-a4 unlk a6 rts *===================================================================* * * * Partie entiere (par valeur) * * * * entree : a7(4) pointe sur n2 de type I ou R * * a7(8) pointe sur n1 de type I ou R * * sortie : la zone pointee par a7(8) contient ent(n2) * * interdit : type S * * * *===================================================================* _mpentz: move.l 4(sp),-(sp) bsr _mpent move.l 12(sp),(sp) move.l d0,-(sp) bsr _mpaff move.l d0,a0 addq.l #8,sp bra.w _giv ********************************************************************* ********************************************************************* *** *** *** PROGRAMMES DE COMPARAISON *** *** *** ********************************************************************* ********************************************************************* *===================================================================* * * * Comparaison generale * * * * entree : a7(4) pointe sur n2 de type I ou R * * a7(8) pointe sur n1 de type I ou R * * sortie : d0.l contient -1 si n2i1,0 si s2=i1,-1 sinon * * d1,a0,a1 sont sauvegardes * * * *===================================================================* _cmpsi: link a6,#0 movem.l d1-d4/a1,-(sp) move.l 12(a6),a1 move.b 4(a1),d1 move.b d1,d4 move.b #1,d3 move.l 8(a6),d2 bgt.b 1f bne.b 2f move.b #0,d3 bra.b 1f 2: move.b #-1,d3 1: eor.b d3,d4 bpl.b 3f moveq #1,d0 tst.b d3 bpl.b 4f moveq #-1,d0 4: bra.b cmpsif 3: cmp.w #3,6(a1) ble.b 5f 8: moveq #-1,d0 tst.b d1 bpl.b 6f neg.l d0 6: bra.b cmpsif 5: cmp.w #2,6(a1) beq.b 7f tst.l d2 bpl.b 9f neg.l d2 9: moveq #1,d0 cmp.l 8(a1),d2 bhi.b L1002 bne.b L1103 moveq #0,d0 bra.b cmpsif L1103: moveq #-1,d0 L1002: tst.b d1 bpl.b cmpsif neg.l d0 bra.b cmpsif 7: moveq #1,d0 tst.b d3 bne.b cmpsif moveq #0,d0 cmpsif: movem.l (sp)+,d1-d4/a1 unlk a6 rts *===================================================================* * * * Comparaison : entier court et reel * * * * entree : a7(4) contient s2 de type S * * a7(8) pointe sur r1 de type R * * sortie : d0.l contient 1 si s2>r1, 0 si s2=r1, -1 sinon * * d1,a0,a1 sont sauvegardes * * * *===================================================================* _cmpsr: link a6,#0 movem.l d1-d4/a0-a2,-(sp) move.l 12(a6),a1 move.b 4(a1),d1 move.b d1,d4 move.b #1,d3 move.l 8(a6),d2 bgt.b 1f bne.b 2f move.b #0,d3 bra.b 1f 2: move.b #-1,d3 1: eor.b d3,d4 bpl.b 3f moveq #1,d0 tst.b d3 bpl.b 4f moveq #-1,d0 4: bra.b cmpsrf 3: tst.b d1 bne.b 5f moveq #1,d0 tst.b d3 bne.b 6f moveq #0,d0 6: bra.b cmpsrf 5: move.w 2(a1),d0 bsr _getr move.l a0,a2 move.l a0,-(sp) move.l d2,-(sp) bsr _affsr addq.l #8,sp move.l a1,-(sp) move.l a0,-(sp) bsr _cmprr addq.l #8,sp move.l a2,a0 bsr _giv cmpsrf: movem.l (sp)+,d1-d4/a0-a2 unlk a6 rts *===================================================================* * * * Comparaison : entier et entier court * * * * entree : a7(4) pointe sur i2 de type I * * a7(8) contient s1 * * sortie : d0.l contient le signe de i2 - s1 * * aucun autre registre n'est affecte * * * *===================================================================* _cmpis: move.l 4(sp),-(sp) move.l 12(sp),-(sp) bsr _cmpsi addq.l #8,sp neg.l d0 rts *===================================================================* * * * Comparaison : entier et entier * * * * entree : a7(4) pointe sur i2 de type I * * a7(8) pointe sur i1 de type I * * sortie : d0.l contient :1 si i2>i1,0 si i2=i1,-1 sinon * * d1,a0,a1 sont sauvegardes * * * *===================================================================* _cmpii: link a6,#0 movem.l d1-d4/a1-a2,-(sp) move.l 8(a6),a2 move.l 12(a6),a1 move.b 4(a1),d1 move.b d1,d4 move.b 4(a2),d2 eor.b d2,d4 bpl.b 1f moveq #1,d0 tst.b d2 bpl.b cmpiif moveq #-1,d0 bra.b cmpiif 1: move.w 6(a1),d1 move.w 6(a2),d2 cmp.w d1,d2 blt.b 3f beq.b 4f 6: moveq #1,d0 tst.b 4(a1) bpl.b cmpiif moveq #-1,d0 bra.b cmpiif 3: moveq #-1,d0 tst.b 4(a2) bpl.b cmpiif moveq #1,d0 bra.b cmpiif 4: cmp.w #2,d1 bne.b 7f moveq #0,d0 bra.b cmpiif 7: move.b 4(a1),d3 addq.l #8,a1 addq.l #8,a2 subq.w #3,d1 L1104: cmpm.l (a1)+,(a2)+ dbne d1,L1104 bhi.b 8f beq.b 9f moveq #-1,d0 bra.b L1003 9: moveq #0,d0 bra.b cmpiif 8: moveq #1,d0 L1003: tst.b d3 bpl.b cmpiif neg.l d0 cmpiif: movem.l (sp)+,d1-d4/a1-a2 unlk a6 rts *===================================================================* * * * Comparaison : entier et reel * * * * entree : a7(4) pointe sur i2 de type R * * a7(8) pointe sur r1 de type R * * sortie : d0.l contient :1 si i2>r1,0 si i2=r1,-1 sinon * * d1,a0,a1 sont sauvegardes * * * *===================================================================* _cmpir: link a6,#0 movem.l d1-d4/a0-a3,-(sp) move.l 8(a6),a2 move.l 12(a6),a1 move.b 4(a1),d1 move.b d1,d4 move.b 4(a2),d2 eor.b d2,d4 bpl.b 1f moveq #1,d0 tst.b d2 bpl.b 2f moveq #-1,d0 2: bra.b cmpirf 1: tst.b d1 bne.b 3f moveq #1,d0 tst.b d2 bne.b 4f moveq #0,d0 4: bra.b cmpirf 3: move.w 2(a1),d0 bsr _getr move.l a0,a3 move.l a0,-(sp) move.l a2,-(sp) bsr _affir addq.l #8,sp move.l a1,-(sp) move.l a0,-(sp) bsr _cmprr addq.l #8,sp move.l a3,a0 bsr _giv cmpirf: movem.l (sp)+,d1-d4/a0-a3 unlk a6 rts *===================================================================* * * * Comparaison : reel et entier court * * * * entree : a7(4) pointe sur r2 de type R * * a7(8) contient s1 * * sortie : d0.l contient le signe de r2 - s1 * * aucun autre registre n'est affecte * * * *===================================================================* _cmprs: move.l 4(sp),-(sp) move.l 12(sp),-(sp) bsr _cmpsr addq.l #8,sp neg.l d0 rts *===================================================================* * * * Comparaison : reel et entier * * * * entree : a7(4) pointe sur r2 de type R * * a7(8) contient i1 * * sortie : d0.l contient le signe de r2 - i1 * * aucun autre registre n'est affecte * * * *===================================================================* _cmpri: move.l 4(sp),-(sp) move.l 12(sp),-(sp) bsr _cmpir addq.l #8,sp neg.l d0 rts *===================================================================* * * * Comparaison : reel et reel * * * * entree : a7(4) pointe sur r2 de type R * * a7(8) pointe sur r1 de type R * * sortie : d0.l contient :1 si r2>r1,0 si r2=r1,-1 sinon * * d1,a0,a1 sont sauvegardes * * * *===================================================================* _cmprr: link a6,#0 movem.l d1-d5/a1-a2,-(sp) move.l 8(a6),a2 move.l 12(a6),a1 move.b 4(a1),d1 move.b d1,d4 move.b 4(a2),d2 eor.b d2,d4 bpl.b 1f moveq #1,d0 tst.b d2 bpl.b 2f moveq #-1,d0 2: bra.b cmprrf 1: tst.b d1 bne.b 3f moveq #1,d0 tst.b d2 bne.b 4f moveq #0,d0 4: bra.b cmprrf 3: tst.b 4(a2) bne.b 5f moveq #-1,d0 bra.b cmprrf 5: moveq #1,d0 move.w 2(a1),d1 move.w 2(a2),d2 cmp.w d1,d2 bpl.b 6f exg d1,d2 exg a1,a2 moveq #-1,d0 6: tst.b 4(a2) bpl.b 7f neg.l d0 7: move.l 4(a1),d5 and.l #0xffffff,d5 move.l 4(a2),d3 and.l #0xffffff,d3 cmp.l d5,d3 bpl.b 8f L1004: neg.l d0 bra.b cmprrf 8: bne.b cmprrf sub.w d1,d2 subq.w #3,d1 addq.l #8,a1 addq.l #8,a2 9: cmpm.l (a1)+,(a2)+ dbne d1,9b bcs.b L1004 beq.b L1105 bra.b cmprrf L1202: tst.l (a2)+ L1105: dbne d2,L1202 bne.b cmprrf moveq #0,d0 cmprrf: movem.l (sp)+,d1-d5/a1-a2 unlk a6 rts ********************************************************************* ********************************************************************* *** *** *** PROGRAMMES D'ADDITION *** *** *** ********************************************************************* ********************************************************************* *===================================================================* * * * Addition generale * * * * entree : a7(4) pointe sur n2 de type I ou R * * a7(8) pointe sur n1 de type I ou R * * sortie : d0 pointe sur n2 + n1 de type I ou R (zone creee) * * interdit : type S * * precision : voir les formules des routines specalisees * * * *===================================================================* _mpadd: move.l 4(sp),a0 move.l 8(sp),a1 move.b (a0),d0 move.b (a1),d1 cmp.b d1,d0 ble.b 1f exg a1,a0 exg d1,d0 move.l a0,4(sp) move.l a1,8(sp) 1: cmp.b #1,d1 beq.w _addii 2: cmp.b #2,d0 beq.w _addrr bra.w _addir *===================================================================* * * * Addition (par valeur) * * * * entree : a7(4) pointe sur n2 de type I ou R * * a7(8) pointe sur n1 de type I ou R * * a7(12) pointe sur n3 de type I ou R * * sortie : la zone pointee par a7(12) contient n2+n1 * * interdit : type S * * * *===================================================================* _mpaddz: lea _mpadd,a0 bra.w mpopz _addssz: lea _addss,a0 bra.w mpopz _addsiz: lea _addsi,a0 bra.w mpopz _addsrz: lea _addsr,a0 bra.w mpopz _addiiz: lea _addii,a0 bra.w mpopz _addirz: lea _addir,a0 bra.w mpopz _addrrz: lea _addrr,a0 bra.w mpopz *===================================================================* * * * Addition : entier court + entier court = entier * * * * entree : a7(4) contient s2 de type S * * a7(8) contient s1 de type S * * sortie : d0 pointe sur s1+s2 de type I(zone cree) * * remarque : s1 + s2 = s0 est interdit * * * *===================================================================* _addss: link a6,#-2 move.l d2,-(sp) move.l 8(a6),d1 move.l 12(a6),d2 add.l d2,d1 bne.b 1f bvs.b 2f move.l _gzero,d0 bra.b addssg 2: move.w #4,d0 bsr _geti move.l #0xff000004,4(a0) move.l #1,8(a0) clr.l 12(a0) bra.b addssf 1: move.w #3,d0 bsr _geti move.l #0x1000003,4(a0) add.l 8(a6),d2 bvs.b 3f bmi.b 4f bra.b 5f 3: bcc.b 5f 4: neg.l d1 move.b #0xff,4(a0) 5: move.l d1,8(a0) addssf: move.l a0,d0 addssg: move.l (sp),d2 unlk a6 rts *===================================================================* * * * Addition : entier court + entier = entier * * * * entree : a7(4) contient s2 de type S * * a7(8) pointe sur i1 de type I * * sortie : d0 pointe sur s2 + i1 de type I (zone creee) * * * *===================================================================* _addsi: link a6,#0 movem.l d2-d4/a2,-(sp) move.l 12(a6),a1 move.l 8(a6),d2 bne.b 1f move.w 6(a1),d0 bsr _geti move.l a0,d4 subq.w #2,d0 addq.l #4,a0 addq.l #4,a1 2: move.l (a1)+,(a0)+ dbra d0,2b bra.w addsif 1: tst.b 4(a1) bne.b 3f moveq #3,d0 bsr _geti move.l a0,d4 move.l #0x1000003,4(a0) move.l d2,8(a0) bpl.w addsif move.b #0xff,4(a0) neg.l 8(a0) bra.w addsif 3: move.w 6(a1),d0 bsr _geti move.l a0,d4 move.w 4(a1),d1 ext.l d1 lea (a0,d0.w*4),a0 lea (a1,d0.w*4),a2 moveq #0,d3 subq.w #3,d0 eor.l d2,d1 bmi.b susi tst.l d2 bpl.b L51 neg.l d2 L51: add.l -(a2),d2 bra.b 4f 5: move.l d2,-(a0) move.l -(a2),d2 addx.l d3,d2 4: dbra d0,5b bcc.b 6f move.l d2,-(a0) moveq #1,d0 bsr _geti move.l a0,d4 move.l 4(a0),(a0) addq.w #1,2(a0) cmp.w #0x7fff,2(a0) bls.b 7f move.l #12,-(sp) jsr _err 7: move.w 2(a0),6(a0) move.w 4(a1),4(a0) move.l #1,8(a0) bra.b 8f 6: move.l d2,-(a0) subq.w #8,a0 move.w 2(a0),6(a0) move.w 4(a1),4(a0) 8: move.l a0,d4 addsif: move.l d4,d0 movem.l (sp)+,d2-d4/a2 unlk a6 rts susi: move.l d2,d1 bpl.b 6f neg.l d1 6: move.l -(a2),d2 sub.l d1,d2 bra.b 1f 2: move.l d2,-(a0) move.l -(a2),d2 subx.l d3,d2 1: dbra d0,2b bcc.b 3f neg.l d2 move.l d2,-(a0) subq.l #8,a0 move.w #3,6(a0) move.b 4(a1),d2 neg.b d2 move.b d2,4(a0) bra.b addsif 3: tst.l d2 beq.b 4f move.l d2,-(a0) move.l 4(a1),-(a0) bra.b addsif 4: move.l 4(a1),-(a0) subq.w #1,2(a0) cmp.w #2,2(a0) bne.b 5f clr.b (a0) 5: move.l -8(a0),-(a0) subq.w #1,2(a0) move.l a0,d4 addq.l #4,_avma bra.b addsif *===================================================================* * * * Addition : entier + entier = entier * * * * entree : a7(4) pointe sur i2 de type I * * a7(8) pointe sur i1 de type I * * sortie : d0 pointe sur i2 + i1 de type I (zone creee) * * * *===================================================================* _addii: link a6,#0 movem.l d2-d7/a2-a4,-(sp) move.l 8(a6),a2 move.l 12(a6),a1 moveq #0,d2 moveq #0,d1 move.w 6(a2),d2 move.w 6(a1),d1 cmp.w d1,d2 bcc.b 1f exg a1,a2 exg d1,d2 1: tst.b 4(a1) bne.b 2f move.w 6(a2),d0 bsr _geti subq.w #2,d0 move.l a0,a1 addq.l #4,a1 addq.l #4,a2 3: move.l (a2)+,(a1)+ dbra d0,3b bra.w addiif 2: move.b 4(a1),d3 move.b 4(a2),d4 eor.b d4,d3 bmi.w suii move.w d2,d0 bsr _geti lea (a0,d0.w*4),a0 lea (a2,d0.w*4),a2 lea (a1,d1.w*4),a1 sub.w d1,d2 subq.w #3,d1 moveq #0,d4 4: move.l -(a1),d0 move.l -(a2),d5 addx.l d5,d0 move.l d0,-(a0) dbra d1,4b roxr.w d4,d0 bra.b 5f 6: move.l -(a2),d0 addx.l d4,d0 move.l d0,-(a0) roxr.w d4,d0 5: dbcc d2,6b bcs.b 7f bra.b 8f 9: move.l -(a2),-(a0) 8: dbra d2,9b move.l -(a2),-(a0) subq.l #4,a0 bra.b addiif 7: move.w -2(a2),d2 addq.w #1,d2 cmp.w #0x8000,d2 bcs.b L1005 move.l #13,-(sp) jsr _err L1005: moveq #1,d0 bsr _geti move.l #1,8(a0) move.l 4(a0),(a0) move.w d2,2(a0) move.l -(a2),4(a0) move.w d2,6(a0) addiif: move.l a0,d0 addiig: movem.l (sp)+,d2-d7/a2-a4 unlk a6 rts suii: move.l a1,a3 move.l a2,a4 sub.w d1,d2 bne.b 1f subq.w #3,d1 addq.l #8,a3 addq.l #8,a4 2: cmpm.l (a3)+,(a4)+ dbne d1,2b bhi.b 1f bne.b 3f move.l _gzero,d0 bra.b addiig 3: exg a1,a2 1: move.w 6(a2),d0 bsr _geti move.w 6(a1),d1 move.l a0,-(sp) move.b 4(a2),d7 lea (a1,d1.w*4),a1 lea (a2,d0.w*4),a2 lea (a0,d0.w*4),a0 sub.l d3,d3 subq.w #3,d1 4: move.l -(a2),d0 move.l -(a1),d5 subx.l d5,d0 move.l d0,-(a0) dbra d1,4b roxr.w d3,d0 bra.b 5f 6: move.l -(a2),d5 subx.l d3,d5 move.l d5,-(a0) roxr.w d3,d0 5: dbcc d2,6b bra.b 7f 8: move.l -(a2),-(a0) 7: dbra d2,8b move.l (sp)+,a0 move.w 2(a0),d1 moveq #0,d2 move.w d1,d2 addq.l #8,a0 9: tst.l (a0)+ dbne d1,9b subq.l #4,a0 move.l d1,-(a0) move.b d7,(a0) move.w d1,-(a0) move.w #0x101,-(a0) sub.w d1,d2 lsl.l #2,d2 add.l d2,_avma bra.w addiif *===================================================================* * * * Addition : entier court + reel = reel * * * * entree : a7(4) contient s2 de type S * * a7(8) pointe sur r1 de type R * * sortie : d0 pointe sur s2 + r1 de type R (zone creee) * * * *===================================================================* _addsr: link a6,#-12 move.l 8(a6),d1 bne.b 1f move.l #0x1000002,-12(a6) move.l #2,-8(a6) bra.b 3f 1: bmi.b 2f move.l #0x1000003,-12(a6) move.l #0x1000003,-8(a6) move.l d1,-4(a6) bra.b 3f 2: move.l #0x1000003,-12(a6) move.l #0xff000003,-8(a6) neg.l d1 move.l d1,-4(a6) 3: move.l 12(a6),-(sp) pea -12(a6) bsr _addir unlk a6 rts *===================================================================* * * * Addition : entier + reel = reel * * * * entree : a7(4) pointe sur i2 de type I * * a7(8) pointe sur r1 de type R * * sortie : d0 pointe sur i2 + r1 de type R (zone creee) * * precision : si exp2>=exp1 , L = L1 + int((exp2-exp1)/32) + 1* * si exp2= exp1 (sinon echanger r1 et r2) * * * *===================================================================* _addrr: link a6,#-16 movem.l d2-d7/a2-a4,-(sp) move.l 8(a6),a2 move.l 12(a6),a1 tst.b 4(a2) bne.w 1f 4: tst.b 4(a1) bne.b L22 move.l 4(a1),d1 cmp.l 4(a2),d1 bgt.b L23 move.l 4(a2),d1 L23: moveq #3,d0 bsr _getr move.l a0,-8(a6) move.l d1,4(a0) clr.l 8(a0) bra.w addrrf L22: moveq #0,d0 move.l 4(a2),d2 move.l 4(a1),d1 and.l #0xffffff,d1 sub.l d2,d1 bcc.b L24 moveq #3,d0 bsr _getr move.l a0,-8(a6) move.l 4(a2),4(a0) clr.l 8(a0) bra.w addrrf L24: lsr.l #5,d1 move.w 2(a1),d0 subq.w #2,d0 cmp.l d1,d0 ble.b L25 move.l d1,d0 addq.l #1,d0 L25: addq.l #2,d0 bsr _getr move.l a0,-8(a6) addq.l #4,a1 addq.l #4,a0 subq.w #2,d0 L27: move.l (a1)+,(a0)+ dbra d0,L27 bra.w addrrf 1: tst.b 4(a1) bne.b 3f exg a2,a1 bra.b L22 3: move.b 4(a1),d3 move.b 4(a2),d5 eor.b d5,d3 move.b d3,-2(a6) move.l 4(a2),d3 and.l #0xffffff,d3 move.l 4(a1),d1 and.l #0xffffff,d1 sub.l d1,d3 beq.w 5f bcc.b 6f exg a1,a2 neg.l d3 6: move.w d3,d4 and.w #31,d4 lsr.l #5,d3 moveq #0,d2 move.w 2(a2),d2 subq.w #2,d2 cmp.l d2,d3 bcs.b 7f move.w 2(a2),d0 bsr _getr move.l a0,-8(a6) addq.l #4,a2 addq.l #4,a0 subq.w #2,d0 L28: move.l (a2)+,(a0)+ dbra d0,L28 bra.w addrrf 7: moveq #0,d1 move.w 2(a1),d1 subq.w #2,d1 move.l d3,d5 add.l d1,d5 cmp.l d2,d5 bcs.b 8f move.b #1,-4(a6) move.w d2,d0 addq.w #2,d0 bsr _getr move.l a0,-8(a6) move.w d2,d5 sub.w d3,d5 move.w d5,d0 addq.w #1,d0 bsr _getr subq.w #2,d0 move.w 2(a2),d1 lea (a2,d1.w*4),a2 bra.b 9f 8: clr.b -4(a6) move.w d5,d0 addq.w #3,d0 bsr _getr move.l a0,-8(a6) lea (a2,d0.w*4),a2 move.w 2(a1),d5 move.w d5,d0 subq.w #2,d5 bsr _getr subq.w #3,d0 9: move.l a0,-12(a6) addq.l #4,a0 move.l a0,a3 addq.l #8,a1 L29: move.l (a1)+,(a0)+ dbra d0,L29 tst.w d4 bne.b L1006 moveq #0,d7 move.w -2(a3),d7 subq.w #1,d7 move.w d7,d2 subq.w #1,d2 lea (a3,d7.w*4),a3 move.l a3,a1 bra.b L1106 L1006: subq.w #1,d5 move.w d5,d2 move.l #-1,d6 lsr.l d4,d6 moveq #0,d0 L1203: move.l (a3),d7 ror.l d4,d7 move.l d7,d1 and.l d6,d1 sub.l d1,d7 add.l d1,d0 move.l d0,(a3)+ move.l d7,d0 dbra d5,L1203 move.l a3,a1 tst.b -4(a6) bne.b L1106 move.l d0,(a1)+ addq.w #1,d2 L1106: move.l -8(a6),a0 moveq #0,d1 move.w 2(a0),d1 lea (a0,d1.w*4),a0 bra.b L1402 5: move.b #2,-4(a6) move.l d1,-16(a6) move.w 2(a1),d0 cmp.w 2(a2),d0 bcs.b L1502 move.w 2(a2),d0 L1502: bsr _getr move.l a0,-8(a6) moveq #0,d2 move.w d0,d2 move.l d2,d0 subq.w #3,d2 moveq #0,d3 move.l a2,a4 move.l a1,a3 lea (a0,d0.w*4),a0 lea (a1,d0.w*4),a1 lea (a2,d0.w*4),a2 L1402: sub.l d4,d4 tst.b -2(a6) bne.w surr L1602: move.l -(a1),d1 move.l -(a2),d5 addx.l d5,d1 move.l d1,-(a0) dbra d2,L1602 roxr.w d4,d0 bcc.b L1702 bra.b L1802 L1902: move.l -(a2),d5 addx.l d4,d5 move.l d5,-(a0) roxr.w d4,d0 L1802: dbcc d3,L1902 bcs.b L2002 bra.b L1702 L30: move.l -(a2),-(a0) L1702: dbra d3,L30 move.l -(a2),-(a0) cmp.b #2,-4(a6) beq.b addrrf move.l -12(a6),a0 bsr _giv bra.b addrrf L2002: move.l -(a2),d1 and.l #0xffffff,d1 addq.l #1,d1 cmp.l #0x1000000,d1 blt.b 2f move.l #15,-(sp) jsr _err 2: cmp.b #2,-4(a6) beq.b L1303 move.l a0,a3 move.l -12(a6),a0 bsr _giv move.l a3,a0 L1303: move.l d1,-4(a0) move.b (a2),-4(a0) move.w -6(a0),d2 subq.w #3,d2 move.w #-1,d0 move.w d0,ccr L31: roxr.w (a0)+ roxr.w (a0)+ dbra d2,L31 addrrf: move.l -8(a6),d0 movem.l (sp)+,d2-d7/a2-a4 unlk a6 rts surr: moveq #0,d6 move.w d2,d6 move.w d2,d7 add.w d3,d7 addq.w #3,d7 cmp.b #2,-4(a6) bne.b 1f addq.l #8,a3 addq.l #8,a4 L1204: cmpm.l (a3)+,(a4)+ dbne d2,L1204 bhi.b 1f bne.b 2f move.l -8(a6),a0 moveq #0,d2 move.w 2(a0),d2 subq.w #2,d2 lsl.l #5,d2 neg.l d2 add.l -16(a6),d2 bpl.b L1503 move.l #16,-(sp) jsr _err L1503: cmp.l #0x1000000,d2 blt.b L1603 move.l #15,-(sp) jsr _err L1603: bsr _giv moveq #3,d0 bsr _getr move.l a0,-8(a6) move.l d2,4(a0) clr.l 8(a0) bra.b addrrf 2: exg a1,a2 1: sub.w d2,d6 sub.l d4,d4 3: move.l -(a2),d0 move.l -(a1),d5 subx.l d5,d0 move.l d0,-(a0) dbra d2,3b roxr.w d4,d0 bra.b 4f 5: move.l -(a2),d5 subx.l d4,d5 move.l d5,-(a0) roxr.w d4,d0 4: dbcc d3,5b bra.b 6f L1304: move.l -(a2),-(a0) 6: dbra d3,L1304 moveq #0,d3 moveq #-1,d2 move.w d2,d3 L1403: tst.l (a0)+ dbne d2,L1403 sub.w d2,d3 add.w d6,d3 sub.l #12,a0 move.l a0,-8(a6) move.l a0,a1 cmp.b #2,-4(a6) beq.b 7f move.l -12(a6),a0 bsr _giv 7: moveq #0,d0 move.w d3,d0 lsl.l #2,d0 add.l d0,_avma move.l a1,a0 move.w #0x201,(a0) sub.w d3,d7 move.w d7,2(a0) lsl.l #5,d3 move.l 8(a0),d0 bfffo d0{0:32},d1 lsl.l d1,d0 add.l d1,d3 lsl.l #2,d6 sub.l d6,a2 move.l -4(a2),d2 and.l #0xffffff,d2 sub.l d3,d2 move.l d2,4(a0) move.b -4(a2),4(a0) tst.b d1 bne.b 8f bra.b 9f 8: moveq #1,d6 lsl.l d1,d6 subq.l #1,d6 addq.l #8,a1 subq.w #3,d7 bra.b L1007 L1107: move.l 4(a1),d2 rol.l d1,d2 move.l d2,d3 and.l d6,d3 sub.l d3,d2 add.l d3,d0 move.l d0,(a1)+ move.l d2,d0 L1007: dbra d7,L1107 move.l d0,(a1) 9: bra.w addrrf ********************************************************************* ********************************************************************* *** *** *** PROGRAMMES DE SOUSTRACTION *** *** *** ********************************************************************* ********************************************************************* *===================================================================* * * * Soustraction generale * * * * entree : a7(4) pointe sur n2 de type I ou R * * a7(8) pointe sur n1 de type I ou R * * sortie : d0 pointe sur n2 - n1 de type I ou R (zone creee) * * interdit : type S * * * *===================================================================* _mpsub: cmp.b #1,([8,sp]) bne.b 1f cmp.b #1,([4,sp]) beq.w _subii bra.w _subri 1: cmp.b #1,([4,sp]) beq.w _subir bra.w _subrr *===================================================================* * * * Soustraction (par valeur) * * * * entree : a7(4) pointe sur n2 de type I ou R * * a7(8) pointe sur n1 de type I ou R * * a7(12) pointe sur n3 de type I ou R * * sortie : la zone pointee par a7(12) contient n2 - n1 * * interdit : type S * * * *===================================================================* _mpsubz: lea _mpsub,a0 bra.w mpopz _subssz: lea _subss,a0 bra.w mpopz _subsiz: lea _subsi,a0 bra.w mpopz _subsrz: lea _subsr,a0 bra.w mpopz _subisz: lea _subis,a0 bra.w mpopz _subiiz: lea _subii,a0 bra.w mpopz _subirz: lea _subir,a0 bra.w mpopz _subrsz: lea _subrs,a0 bra.w mpopz _subriz: lea _subri,a0 bra.w mpopz _subrrz: lea _subrr,a0 bra.w mpopz *===================================================================* * * * Soustraction : entier court - entier court = entier * * * * entree : a7(4) contient s2 de type S * * a7(8) contient s1 de type S * * sortie : d0 pointe sur s2 - s1 de type I (zone creee) * * remarque : s2 - s1 = s0 est interdit * * * *===================================================================* _subss: link a6,#-12 move.l 12(a6),d1 neg.l d1 bvs.b 1f move.l d1,-(sp) move.l 8(a6),-(sp) bsr _addss bra.b subssf 1: move.l #0x1000003,-12(a6) move.l #0x1000003,-8(a6) move.l #0x80000000,-4(a6) pea -12(a6) move.l 8(a6),-(sp) bsr _addsi subssf: unlk a6 rts *===================================================================* * * * Soustraction : entier - entier = entier * * * * entree : a7(4) pointe sur i2 de type I * * a7(8) pointe sur i1 de type I * * sortie : d0 pointe sur i2 - i1 de type I (zone creee) * * * *===================================================================* _subii: link a6,#-4 move.l 12(a6),-(sp) move.l 8(a6),-(sp) move.l 12(a6),a0 neg.b 4(a0) move.l a0,-4(a6) bsr _addii move.l -4(a6),a0 neg.b 4(a0) unlk a6 rts *===================================================================* * * * Soustraction : reel - reel = reel * * * * entree : a7(4) pointe sur r2 de type R * * a7(8) pointe sur r1 de type R * * sortie : d0 pointe sur r2 - r1 de type R (zone creee) * * * *===================================================================* _subrr: link a6,#-4 move.l 12(a6),-(sp) move.l 8(a6),-(sp) move.l 12(a6),a0 neg.b 4(a0) move.l a0,-4(a6) bsr _addrr move.l -4(a6),a0 neg.b 4(a0) unlk a6 rts *===================================================================* * * * Soustraction : entier court - entier = entier * * * * entree : a7(4) contient s2 de type S * * a7(8) pointe sur i1 de type I * * sortie : d0 pointe sur s2 - i1 de type I * * * *===================================================================* _subsi: link a6,#-4 move.l 12(a6),-(sp) move.l 8(a6),-(sp) move.l 12(a6),a0 neg.b 4(a0) move.l a0,-4(a6) bsr _addsi move.l -4(a6),a0 neg.b 4(a0) unlk a6 rts *===================================================================* * # * Soustraction : entier court - reel = reel * * * * entree : a7(4) contient s2 de type S * * a7(8) pointe sur r1 de type R * * sortie : d0 pointe sur s2 - r1 de type R (zone creee) * * * *===================================================================* _subsr: link a6,#-4 move.l 12(a6),-(sp) move.l 8(a6),-(sp) move.l 12(a6),a0 neg.b 4(a0) move.l a0,-4(a6) bsr _addsr move.l -4(a6),a0 neg.b 4(a0) unlk a6 rts *===================================================================* * * * Soustraction : entier - entier court = entier * * * * entree : a7(4) pointe sur i1 de type I * * a7(8) contient s2 de type S * * sortie : d0 pointe sur i1 - s2 de type I (zone creee) * * * *===================================================================* _subis: link a6,#-12 move.l 8(a6),-(sp) move.l 12(a6),d1 neg.l d1 bvs.b 1f move.l d1,-(sp) bsr _addsi bra.b subisf 1: move.l #0x1000003,-12(a6) move.l #0x1000003,-8(a6) move.l #0x80000000,-4(a6) pea -12(a6) bsr _addii subisf: unlk a6 rts *===================================================================* * * * Soustraction : entier - reel = reel * * * * entree : a7(4) pointe sur i2 de type I * * a7(8) pointe sur r1 de type R * * sortie : d0 pointe sur i2 - r1 de type R (zone creee) * * * *===================================================================* _subir: link a6,#-4 move.l 12(a6),-(sp) move.l 8(a6),-(sp) move.l 12(a6),a0 neg.b 4(a0) move.l a0,-4(a6) bsr _addir move.l -4(a6),a0 neg.b 4(a0) unlk a6 rts *===================================================================* * * * Soustraction : reel - entier = reel * * * * entree : a7(4) pointe sur r1 de type R * * a7(8) pointe sur i2 de type I * * sortie : d0 pointe sur r2 - i1 de type R (zone creee) * * * *===================================================================* _subri: link a6,#-4 move.l 8(a6),-(sp) move.l 12(a6),-(sp) move.l 12(a6),a0 neg.b 4(a0) move.l a0,-4(a6) bsr _addir move.l -4(a6),a0 neg.b 4(a0) unlk a6 rts *===================================================================* * * * Soustraction : reel - entier court = reel * * * * entree : a7(4) pointe sur r2 de type R * * a7(8) contient s1 de type S * * sortie : d0 pointe sur r2 - s1 de type R (zone creee) * * * *===================================================================* _subrs: link a6,#-12 move.l 8(a6),-(sp) move.l 12(a6),d1 neg.l d1 bvs.b 1f move.l d1,-(sp) bsr _addsr bra.b subsrf 1: move.l #0x1000003,-12(a6) move.l #0x1000003,-8(a6) move.l #0x80000000,-4(a6) pea -12(a6) bsr _addir subsrf: unlk a6 rts ********************************************************************* ********************************************************************* *** *** *** PROGRAMMES DE MULTIPLICATION *** *** *** ********************************************************************* ********************************************************************* *===================================================================* * * * Multiplication generale * * * * entree : a7(4) pointe sur n2 de type I ou R * * a7(8) pointe sur n1 de type I ou R * * sortie : d0 pointe sur n2 * n1 de type I ou R (zone cree) * * interdit : type S * * precision : voir routines specialisees * * * *===================================================================* _mpmul: move.l 4(sp),a0 move.l 8(sp),a1 move.b (a0),d0 move.b (a1),d1 cmp.b d1,d0 ble.b 1f exg a1,a0 exg d1,d0 move.l a0,4(sp) move.l a1,8(sp) 1: cmp.b #1,d1 beq.w _mulii 2: cmp.b #2,d0 beq.w _mulrr bra.w _mulir *===================================================================* * * * Multiplication (par valeur) * * * * entree : a7(4) pointe sur n2 de type I ou R * * a7(8) pointe sur n1 de type I ou R * * a7(12) pointe sur n3 de type I ou R * * sortie : la zone pointee par a7(12) contient n2*n1 * * interdit : type S * * * *===================================================================* _mpmulz: lea _mpmul,a0 bra.w mpopz _mulssz: lea _mulss,a0 bra.w mpopz _mulsiz: lea _mulsi,a0 bra.w mpopz _mulsrz: lea _mulsr,a0 bra.w mpopz _muliiz: lea _mulii,a0 bra.w mpopz _mulirz: lea _mulir,a0 bra.w mpopz _mulrrz: lea _mulrr,a0 bra.w mpopz *===================================================================* * * * Multiplication : entier court * entier court = entier * * * * entree : a7(4) contient s2 de type S * * a7(8) contient s1 de type S * * sortie : d0 pointe sur s2 * s1 de type I (zone creee) * * * *===================================================================* _mulss: link a6,#-2 movem.l d2-d4,-(sp) move.l 8(a6),d2 bne.b 1f 2: move.l _gzero,d0 bra.b mulssg 1: move.l d2,d4 bpl.b 3f neg.l d2 3: move.l 12(a6),d1 beq.b 2b eor.l d1,d4 tst.l d1 bpl.b 4f neg.l d1 4: mulu.l d1,d3:d2 move.w #4,d0 tst.l d3 bne.b 5f move.w #3,d0 5: bsr _geti move.w 2(a0),6(a0) move.b #1,4(a0) tst.l d4 bpl.b 6f neg.b 4(a0) 6: tst.l d3 bne.b 7f move.l d2,8(a0) bra.b mulssf 7: move.l d3,8(a0) move.l d2,12(a0) mulssf: move.l a0,d0 mulssg: movem.l (sp)+,d2-d4 unlk a6 rts _mulmodll: move.l 4(sp),d1 mulu.l 8(sp),d0:d1 divu.l 12(sp),d0:d1 rts *===================================================================* * * * Multiplication : entier court * entier = entier * * * * entree : a7(4) contient s2 de type S * * a7(8) pointe sur i1 de type I * * sortie : d0 pointe sur s2 * i1 de type I (zone creee) * * * *===================================================================* _mulsi: link a6,#0 movem.l d2-d6/a2,-(sp) move.l 8(a6),d2 bne.b 1f 2: move.l _gzero,d0 bra.b mulsig 1: bpl.b 6f neg.l d2 6: move.l 12(a6),a1 tst.b 4(a1) beq.b 2b move.w 6(a1),d0 bsr _geti lea (a0,d0.w*4),a2 lea (a1,d0.w*4),a1 subq.w #3,d0 moveq #0,d6 moveq #0,d5 3: move.l -(a1),d4 mulu.l d2,d3:d4 add.l d5,d4 addx.l d6,d3 move.l d4,-(a2) move.l d3,d5 dbra d0,3b beq.b 5f move.w #1,d0 bsr _geti move.w 6(a0),d0 addq.w #1,d0 bvc.b 4f move.l #19,-(sp) jsr _err 4: move.w d0,2(a0) move.l d5,8(a0) 5: move.w 2(a0),6(a0) move.b -4(a1),4(a0) tst.l 8(a6) bpl.b mulsif neg.b 4(a0) mulsif: move.l a0,d0 mulsig: movem.l (sp)+,d2-d6/a2 unlk a6 rts *===================================================================* * * * Multiplication : entier court * reel = reel * * * * entree : a7(4) contient s2 de type S * * a7(8) pointe sur r1 de type R * * sortie : d0 pointe sur s2 * r1 de type R * * de longueur L = L1 (zone creee) * * * *===================================================================* _mulsr: link a6,#-4 movem.l d2-d6/a2,-(sp) move.l 8(a6),d2 bne.b 1f move.l _gzero,d0 bra.w mulsrf1 1: move.l 12(a6),a1 tst.b 4(a1) bne.b 2f moveq #3,d0 bsr _getr tst.l d2 bpl.b 2f neg.l d2 bfffo d2{0:32},d0 move.l 4(a1),d1 add.l #31,d1 sub.l d0,d1 cmp.l #0x1000000,d1 bcc.w L1108 move.l d1,4(a0) clr.l 8(a0) move.l a0,d0 bra.w mulsrf1 2: move.w 2(a1),d0 bsr _getr move.l a0,-4(a6) move.l d2,d4 bpl.b 3f neg.l d2 3: cmp.l #1,d2 bne.b 4f addq.l #4,a0 addq.l #4,a1 subq.w #2,d0 5: move.l (a1)+,(a0)+ dbra d0,5b move.l -4(a6),a0 tst.l d4 bpl.w mulsrf neg.b 4(a0) bra.w mulsrf 4: move.b 4(a1),4(a0) tst.l d4 bpl.b 6f neg.b 4(a0) 6: lea (a0,d0.w*4),a0 lea (a1,d0.w*4),a1 subq.w #3,d0 move.w d0,d4 move.w d4,d6 moveq #0,d1 moveq #0,d0 7: move.l -(a1),d5 mulu.l d2,d3:d5 add.l d0,d5 addx.l d1,d3 move.l d5,-(a0) move.l d3,d0 dbra d6,7b bfffo d0{0:32},d1 lsl.l d1,d0 moveq #1,d6 lsl.l d1,d6 subq.l #1,d6 neg.b d1 add.b #32,d1 8: move.l (a0),d2 ror.l d1,d2 move.l d2,d3 and.l d6,d3 sub.l d3,d2 add.l d3,d0 move.l d0,(a0)+ move.l d2,d0 dbra d4,8b move.l -4(a6),a0 move.l -4(a1),d0 and.l #0xffffff,d0 add.l d1,d0 btst #24,d0 beq.b 9f L1108: move.l #18,-(sp) jsr _err 9: move.w d0,6(a0) swap d0 move.b d0,5(a0) mulsrf: move.l -4(a6),d0 mulsrf1: movem.l (sp)+,d2-d6/a2 unlk a6 rts *===================================================================* * * * Multiplication : entier * entier = entier * * * * entree : a7(4) pointe sur i2 de type I * * a7(8) pointe sur i1 de type I * * sortie : d0 pointe sur i2 * i1 de type I (zone creee) * * * *===================================================================* _mulii: link a6,#0 movem.l d2-d7/a2-a4,-(sp) move.l 8(a6),a1 move.l 12(a6),a2 move.w 6(a1),d1 move.w 6(a2),d2 cmp.w d1,d2 bcc.b 1f exg a1,a2 exg d1,d2 1: subq.w #2,d1 bne.b 2f 6: move.l _gzero,d0 bra.w muliig 2: move.w d2,d0 add.w d1,d0 bvc.b 3f move.l #17,-(sp) jsr _err bra.b 6b 3: bsr _geti move.w d0,6(a0) move.b 4(a1),d3 move.b 4(a2),d4 eor.b d4,d3 addq.b #1,d3 move.b d3,4(a0) lea (a0,d0.w*4),a4 lea (8,a1,d1.w*4),a1 lea (a2,d2.w*4),a3 subq.w #1,d1 subq.w #3,d2 move.w d2,d0 moveq #0,d7 *; x=x1x2...xn multiplicande (x=i2,n=L2) pointe par a2 et a3 * *; y=y1...ym multiplicateur (y=i1,m=L1) pointe par a1 * *; z=z1z2...z(n+m) resultat pointe par a0 et a4 * *; a0 et a2 sont decrementes par la boucle interne (les valeurs initiales * *; etant conservees dans a4 et a3) * *...................................................................* move.l a3,a2 move.l a4,a0 move.l -(a1),d3 sub.l d4,d4 m1: move.l d4,d6 move.l d3,d5 mulu.l -(a2),d4:d5 addx.l d5,d6 addx.l d7,d4 move.l d6,-(a0) dbra d2,m1 bra.b bclf mext: subq.l #4,a4 move.l a3,a2 move.l a4,a0 move.l d0,d2 move.l -(a1),d3 sub.l d4,d4 mint: move.l d4,d6 move.l d3,d5 mulu.l -(a2),d4:d5 addx.l d5,d6 addx.l d7,d4 add.l d6,-(a0) dbra d2,mint addx.l d7,d4 bclf: move.l d4,-(a0) dbra d1,mext *...................................................................* beq.b 4f subq.l #8,a0 bra.b muliif 4: subq.w #1,-2(a0) subq.w #1,-6(a0) move.l -4(a0),(a0) move.l -8(a0),-(a0) add.l #4,_avma muliif: move.l a0,d0 muliig: movem.l (sp)+,d2-d7/a2-a4 unlk a6 rts *===================================================================* * * * Multiplication : reel * reel = reel * * * * entree : a7(4) pointe sur r2 de type R * * a7(8) pointe sur r1 de type R * * sortie : d0 pointe sur r2 * r1 de type R (zone creee) * * * * precision : L = inf ( L1 , L2 ) * * * *===================================================================* _mulrr: link a6,#-20 movem.l d2-d7/a2-a4,-(sp) move.l 8(a6),a1 move.l 12(a6),a2 move.b 4(a1),d0 and.b 4(a2),d0 bne.b munzr muzr: moveq #3,d0 bsr _getr move.l a0,-8(a6) move.l 4(a1),d1 and.l #0xffffff,d1 move.l 4(a2),d2 and.l #0xffffff,d2 add.l d2,d1 sub.l #0x800000,d1 cmp.l #0x1000000,d1 bcs.b 1f move.l #20,-(sp) jsr _err 1: tst.l d1 bgt.b 2f move.l #21,-(sp) jsr _err 2: move.l d1,4(a0) clr.l 8(a0) bra.b mulrrf munzr: move.w 2(a2),d0 clr.l -12(a6) cmp.w 2(a1),d0 bls.b 1f move.w 2(a1),d0 exg a1,a2 bra.b 2f 1: bne.b 2f lea (a1,d0.w*4),a3 move.l a3,-12(a6) move.l (a3),-16(a6) clr.l (a3) 2: bsr _getr move.l a0,-8(a6) bsr murr tst.l -12(a6) beq.b mulrrf move.l -12(a6),a1 move.l -16(a6),(a1) mulrrf: move.l -8(a6),d0 movem.l (sp)+,d2-d7/a2-a4 unlk a6 rts *-------------------------------------------------------------------* * module interne de multiplication r0=r1*r2 * * ( pour R*R et I*R) * * entree : a1 et a2 pointent sur 2 reels * * r1,r2 non nuls avec L1>=L2=m * * a0 pointe sur une zone reelle de long l1 * * sortie : le produit r0 est mis a l'addresse a0 * * * *-------------------------------------------------------------------* *; notation : r1 = x = x1x2...xmx(m+1)... multiplicande * * ; r2 = y = y1y2...ym multiplicateur * * ; ( le lgmot x(m+1) peut ne pas exister ! ( le1 >= le2 = m ) ) * * ; z = z0z1z2...zmz(m+1) resultat. * * ; ( z0=0 ou 1 et z(m+1) a jeter) * * move.w 2(a2),d0 doit avoir ete fait avant l'appel * murr: move.l a1,a3 lea 12(a3),a3 lea (a2,d0.w*4),a2 lea (a0,d0.w*4),a0 move.l (a0),-4(a6) clr.l (a0)+ subq.w #3,d0 move.l d0,-20(a6) clr.w d3 *...................................................................* bext: move.l a0,a4 move.l a3,a1 move.w d3,d2 move.l -(a2),d4 move.l (a3)+,d5 sub.l d1,d1 mulu.l d4,d7:d5 bint: move.l d7,d6 move.l d4,d5 mulu.l -(a1),d7:d5 addx.l d5,d6 addx.l d1,d7 add.l d6,-(a4) dbra d2,bint addx.l d1,d7 move.l d7,-(a4) addq.w #1,d3 dbra d0,bext *...................................................................* move.l -4(a1),d1 and.l #0xffffff,d1 move.l -4(a2),d2 and.l #0xffffff,d2 add.l d2,d1 sub.l #0x800000,d1 tst.l (a4) bpl.b 1f add.l #1,d1 bra.b 2f 1: move.l a0,a4 subq.w #2,a4 move.l -20(a6),d0 roxl.w -(a4) 5: roxl.w -(a4) roxl.w -(a4) dbra d0,5b 2: cmp.l #0x1000000,d1 bcs.b 3f move.l #20,-(sp) jsr _err 3: tst.l d1 bgt.b 4f move.l #21,-(sp) jsr _err 4: move.l d1,-(a4) move.b -4(a1),d1 move.b -4(a2),d2 eor.b d2,d1 addq.b #1,d1 move.b d1,(a4) move.l -4(a6),-4(a0) murrf: rts *===================================================================* * * * Multiplication : entier * reel = reel * * * * entree : a7(4) pointe sur i2 de type I * * a7(8) pointe sur r1 de type R * * sortie : d0 pointeur sur i2 * r1 de type R (zone creee) * * * *===================================================================* _mulir: link a6,#-20 movem.l d2-d7/a2-a4,-(sp) move.l 8(a6),a2 tst.b 4(a2) bne.b 1f move.l _gzero,d0 bra.w mulirf1 1: move.l 12(a6),a1 tst.b 4(a1) bne.b 2f moveq #3,d0 bsr _getr move.w 6(a2),d0 lsl.l #5,d0 bfffo 8(a2){0:32},d1 sub.l d1,d0 sub.l #65,d0 add.l 4(a1),d0 cmp.l #0x1000000,d0 bcs.b 3f move.l #22,-(sp) jsr _err 3: move.l d0,4(a0) clr.l 8(a0) move.l a0,d0 bra.b mulirf1 2: move.w 2(a1),d0 bsr _getr move.l a0,-8(a6) addq.w #1,d0 bsr _getr move.l a0,-(a7) move.l a2,-(a7) bsr _affir addq.l #4,sp move.l (a7),a2 move.l -8(a6),a0 exg a1,a2 move.w 2(a2),d0 bsr murr move.l (a7)+,a0 bsr _giv mulirf: move.l -8(a6),d0 mulirf1: movem.l (sp)+,d2-d7/a2-a4 unlk a6 rts ********************************************************************* ********************************************************************* *** *** *** PROGRAMMES DE DIVISION AVEC RESTE *** *** *** ********************************************************************* ********************************************************************* *===================================================================* * * * Division avec reste (par valeur) * * * * entree : a7(4) pointe sur n2 de type I * * a7(8) pointe sur n1 de type I * * a7(12) pointe sur n3 de type I * * a7(16) pointe sur n4 de type I * * sortie : la zone pointee par a7(12) contient n2 / n1 * * la zone pointee par a7(16) contient le reste (du * * signe du dividende) * * interdit : type S et R * * * *===================================================================* _mpdvmdz: lea _dvmdii,a0 bra.w mpopii _dvmdssz: lea _dvmdss,a0 bra.w mpopii _dvmdsiz: lea _dvmdsi,a0 bra.w mpopii _dvmdisz: lea _dvmdis,a0 bra.w mpopii _dvmdiiz: lea _dvmdii,a0 bra.w mpopii *===================================================================* * * *Division avec reste : entier court / entier court =(entier,entier) * * * * entree : a7(4) contient s2 de type S * * a7(8) contient s1 de type S * * sortie : a7(12) pointe sur l'adresse du futur reste * * d0 pointe sur s2 div s1 de type I * * le reste est du signe de s2 (zone creee) * * * *===================================================================* _dvmdss: link a6,#0 move.l d2,-(sp) move.l 12(a6),-(sp) move.l 8(a6),-(sp) bsr _divss dmd: addq.l #8,sp tst.l d1 bne.b 1f move.l _gzero,a0 bra.b dvmdssf 1: move.l d0,d2 moveq #3,d0 bsr _geti move.l #0x1000003,4(a0) tst.l d1 bpl.b 2f neg.l d1 move.b #-1,4(a0) 2: move.l d1,8(a0) move.l d2,d0 dvmdssf: move.l 16(a6),a1 move.l a0,(a1) move.l (sp),d2 unlk a6 rts *===================================================================* * * * Division avec reste : entier court / entier = (entier,entier) * * * * entree : a7(4) contient s2 de type S * * a7(8) pointe sur i1 de type I * * a7(12) pointe sur l'adresse du futur reste * * sortie : d0 pointe sur s2 div i1 de type I ; * * reste du signe de s2 (zones creees) * * * *===================================================================* _dvmdsi: move.l 8(a7),-(sp) move.l 8(a7),-(sp) bsr _divsi dmdi: addq.l #8,sp move.l d0,a1 tst.l d1 bne.b 1f move.l _gzero,([12,sp]) rts 1: moveq #3,d0 bsr _geti move.l #0x1000003,4(a0) tst.l d1 bpl.b 2f neg.l d1 move.b #-1,4(a0) 2: move.l d1,8(a0) 3: move.l a1,d0 move.l a0,([12,sp]) rts *===================================================================* * * * Division avec reste : entier / entier court = (entier,entier) * * * * entree : a7(4) pointe sur i2 de type I * * a7(8) contient s1 de type S * * a7(12) pointe sur l'adresse du futur reste * * sortie : d0 pointe sur i2 div s1 de type I * * reste de type I du signe de s1 (zones creees) * * * *===================================================================* _dvmdis: move.l 8(a7),-(sp) move.l 8(a7),-(sp) bsr _divis bra.b dmdi *===================================================================* * * * Division avec reste : entier / entier = (entier,entier) * * * * entree : a7(4) pointe sur i2 de type I (dividende) * * a7(8) pointe sur i1 de type I (diviseur) * * a7(12) contient un pointeur sur le reste si l'on * * veut a la fois q et r, 0 si l'on ne veut que le * * quotient, -1 si l'on ne veut que le reste * * sortie : d0 pointe sur q si celui-ci est attendu, et sinon * * sur r. a7(12) pointe sur r si q et r sont attendus* * (toutes les zones sont creees) * * remarque : il s'agit de la 'fausse division' ; le reste est * * du signe du dividende * * * * * * variable.bs locales (etat pile apres link): * * -16 -14 -12 -10 -8 -6 -4 a6 4 8 12 16 * * +---+---+---+---+---+---+------+----+----+----+----+----+ * * n-m k sgnq sgnr n m ad(q,r) ret i2 i1 ^r/0/-1 * * * *===================================================================* _dvmdii: link a6,#-32 movem.l d2-d7/a2-a4,-(sp) move.l 12(a6),a1 move.w 6(a1),d1 cmp.w #2,d1 bne.b dv1 move.l #36,-(sp) dvmerr: jsr _err dv1: move.l 8(a6),a2 move.w 6(a2),d2 cmp.w #2,d2 bne.b dv3 dv2: move.l 16(a6),d3 cmp.l #-1,d3 beq.b 1f move.l _gzero,d0 1: tst.l d3 beq.w dvmiif move.l _gzero,a0 btst #0,d3 bne.b 2f move.l d3,a1 move.l a0,(a1) bra.w dvmiif 2: move.l a0,d0 bra.w dvmiif dv3: move.w d2,d0 sub.w d1,d0 bcc.b dv4 move.l 16(a6),d3 cmp.l #-1,d3 beq.b 1f move.l _gzero,d0 1: tst.l d3 beq.w dvmiif move.l d0,d1 move.w d2,d0 bsr _geti move.l a0,a1 subq.w #2,d0 addq.l #4,a0 addq.l #4,a2 2: move.l (a2)+,(a0)+ dbra d0,2b cmp.l #-1,d3 beq.b 3f move.l d3,a0 move.l a1,(a0) move.l d1,d0 bra.w dvmiif 3: move.l a1,d0 bra.w dvmiif dv4: move.b 4(a1),d3 move.b 4(a2),d4 eor.b d4,d3 addq.b #1,d3 move.b d3,-12(a6) move.b d4,-10(a6) move.l _avma,-20(a6) move.w d2,d0 bsr _geti move.l a0,-4(a6) subq.w #2,d1 subq.w #2,d2 move.w d1,-6(a6) move.w d2,-8(a6) move.w d2,-16(a6) sub.w d1,-16(a6) addq.l #8,a2 addq.l #8,a1 move.l (a1),d3 subq.w #1,d2 subq.w #1,d1 bne.b divlon divsim: clr.l d4 1: move.l (a2)+,d5 divu.l d3,d4:d5 move.l d5,(a0)+ dbra d2,1b move.l d4,(a0) move.l a0,a2 clr.w -14(a6) bra.w ranger divlon: bfffo d3{0:32},d4 move.w d4,-14(a6) bne.b 1f move.l a0,a4 move.l #0,(a4)+ 4: move.l (a2)+,(a4)+ dbra d2,4b move.l a0,a2 lea (4,a1,d1.w*4),a3 bra.b nosh 1: lsl.l d4,d3 move.w -6(a6),d0 bsr _geti moveq #1,d6 lsl.l d4,d6 subq.l #1,d6 move.l a0,a3 subq.w #1,d0 addq.l #4,a1 bra.b 3f 2: move.l (a1)+,d1 rol.l d4,d1 move.l d1,d5 and.l d6,d1 add.l d1,d3 move.l d3,(a3)+ sub.l d1,d5 move.l d5,d3 3: dbra d0,2b move.l d3,(a3)+ move.l a0,a1 move.l -4(a6),a4 moveq #0,d3 move.w -8(a6),d0 subq.w #1,d0 5: move.l (a2)+,d1 rol.l d4,d1 move.l d1,d5 and.l d6,d1 add.l d1,d3 move.l d3,(a4)+ sub.l d1,d5 move.l d5,d3 dbra d0,5b move.l d3,(a4) move.l -4(a6),a2 nosh: move.w -6(a6),d6 lea (4,a2,d6.w*4),a4 subq.w #1,d6 move.w -16(a6),d7 *-------------------------------------------------------------------* bclext: move.l (a1),d0 cmp.l (a2),d0 bne.b 1f moveq #-1,d1 add.l 4(a2),d0 bcs.b 4f move.l d0,d2 bra.b 2f 1: move.l (a2),d2 move.l 4(a2),d1 divu.l d0,d2:d1 2: move.l 4(a1),d3 mulu.l d1,d4:d3 sub.l 8(a2),d3 subx.l d2,d4 bls.b 4f 3: subq.l #1,d1 sub.l 4(a1),d3 subx.l d0,d4 bhi.b 3b 4: move.w d6,d0 move.l a3,a1 move.l a4,a2 moveq #0,d2 sub.l d3,d3 5: move.l -(a1),d5 mulu.l d1,d4:d5 addx.l d3,d5 addx.l d2,d4 sub.l d5,-(a2) move.l d4,d3 dbra d0,5b addx.l d2,d3 sub.l d3,-4(a2) bcc.b 6f subq.l #1,d1 move.w d6,d0 move.l a3,a1 move.l a4,a2 7: addx.l -(a1),-(a2) dbra d0,7b 6: move.l d1,-4(a2) addq.l #4,a4 dbra d7,bclext *-------------------------------------------------------------------* ranger: clr.l -28(a6) clr.l -32(a6) move.l _avma,-24(a6) move.l -20(a6),d7 sub.l _avma,d7 move.l 16(a6),d3 cmp.l #-1,d3 beq.b rngres move.l -4(a6),a0 move.w -16(a6),d0 move.w d0,d1 addq.w #2,d0 tst.l (a0) beq.b 1f addq.w #1,d0 1: bsr _geti move.l a0,-28(a6) add.l d7,-28(a6) lea (a0,d0.w*4),a1 move.l a2,a3 2: move.l -(a3),-(a1) dbra d1,2b move.w d0,6(a0) move.b -12(a6),4(a0) cmp.w #2,d0 bne.b rngres clr.b 4(a0) rngres: tst.l d3 beq.b rendre move.w -6(a6),d0 subq.w #1,d0 4: tst.l (a2)+ dbne d0,4b bne.b 1f move.w #2,d0 bsr _geti move.l #2,4(a0) add.l d7,a0 move.l a0,-32(a6) bra.b rendre 1: subq.l #4,a2 move.w d0,d1 addq.w #3,d0 bsr _geti move.l a0,-32(a6) add.l d7,-32(a6) move.b -10(a6),4(a0) move.w d0,6(a0) addq.l #8,a0 move.w -14(a6),d3 bne.b 2f 5: move.l (a2)+,(a0)+ dbra d1,5b bra.b rendre 2: moveq #-1,d6 lsr.l d3,d6 moveq #0,d5 bset d3,d5 moveq #0,d2 cmp.l (a2),d5 bls.b 3f move.l (a2)+,d2 ror.l d3,d2 subq.w #1,d0 subq.w #1,-2(a0) 3: move.l (a2)+,d5 ror.l d3,d5 move.l d5,d4 and.l d6,d4 add.l d4,d2 move.l d2,(a0)+ sub.l d4,d5 move.l d5,d2 dbra d1,3b rendre: move.l -20(a6),a0 move.l -24(a6),a1 move.l a1,d0 sub.l _avma,d0 lsr.l #2,d0 subq.w #1,d0 1: move.l -(a1),-(a0) dbra d0,1b move.l a0,_avma move.l -28(a6),d0 bne.b 2f move.l -32(a6),d0 bra.b dvmiif 2: tst.l -32(a6) beq.b dvmiif move.l 16(a6),a1 move.l -32(a6),(a1) dvmiif: movem.l (sp)+,d2-d7/a2-a4 unlk a6 rts *===================================================================* * * * Divisibilite de i2 par i1 * * * * entree : a7(4) pointe sur n2 de type I * * a7(8) pointe sur n1 de type I * * a7(12) contient un pointeur ( pour quotient ) * * sortie : d0 contient 1 si n1 divise n2 * * 0 sinon * a7(12) pointe sur n2 / n1 de type I (zone creee) * * lorsque n1 divise n2, sinon n'est pas affecte. * * * *===================================================================* _mpdivis: link a6,#-8 move.l _avma,-8(a6) pea -4(a6) move.l 12(a6),-(sp) move.l 8(a6),-(sp) bsr _dvmdii lea 12(sp),sp tst.b ([-4,a6],4) beq.b 1f moveq #0,d0 move.l -8(a6),_avma bra.b 2f 1: move.l 16(a6),-(sp) move.l d0,-(sp) bsr _affii moveq #1,d0 move.l -8(a6),_avma 2: unlk a6 rts *===================================================================* * * * Flag de divisibilite de i2 par i1 * * * * entree : a7(4) pointe sur n2 de type I * * a7(8) pointe sur n1 de type I * * sortie : d0 contient 1 si n1 divise n2 * * 0 sinon * * * *===================================================================* _divise: move.l #-1,-(sp) move.l 12(sp),-(sp) move.l 12(sp),-(sp) bsr _dvmdii lea 12(sp),sp move.l d0,a0 moveq #1,d0 tst.b 4(a0) beq.w _giv moveq #0,d0 bra.w _giv ********************************************************************* ********************************************************************* *** *** *** PROGRAMMES DE DIVISION *** *** *** ********************************************************************* ********************************************************************* *===================================================================* * * * Division generale * * * * entree : a7(4) pointe sur n2 de type I ou R * * a7(8) pointe sur n1 de type I ou R * * sortie : d0 pointe sur n2 / n1 de type I ou R (zone creee) * * Le reste est du signe du dividende * * interdit : type S * * precision : voir routines specialisees * * * *===================================================================* _mpdiv: cmp.b #1,([8,sp]) bne.b 1f cmp.b #1,([4,sp]) beq.w _divii bra.w _divri 1: cmp.b #1,([4,sp]) beq.w _divir bra.w _divrr *===================================================================* * * * Division (par valeur) * * * * entree : a7(4) pointe sur n2 de type I ou R * * a7(8) pointe sur n1 de type I ou R * * a7(12) pointe sur n3 de type I ou R * * sortie : la zone pointee par a7(12) contient n2 / n1 de * * type le type de n3 * * interdit : type S ainsi que les divisions suivantes : * * R/I=I , I/R=I ,R/R=I * * * *===================================================================* _mpdivz: move.l a2,-(sp) move.l _avma,-(sp) move.l 12(sp),a1 move.l 16(sp),a0 move.l 20(sp),a2 cmp.b #1,(a2) bne.b 1f cmp.b #1,(a1) beq.b 2f 3: move.l #35,-(sp) jsr _err 2: cmp.b #1,(a0) bne.b 3b move.l a0,-(sp) move.l a1,-(sp) bsr _divii move.l a2,4(sp) move.l d0,(sp) bsr _affii addq.l #8,sp bra.b divzf 1: move.l a0,-(sp) cmp.b #1,(a0) beq.b 4f move.l a1,-(sp) cmp.b #1,(a1) beq.b 5f bsr _divrr bra.b 6f 5: bsr _divir bra.b 6f 4: cmp.b #1,(a1) beq.b 7f move.l a1,-(sp) bsr _divri bra.b 6f 7: move.w 6(a1),d0 addq.w #1,d0 bsr _getr move.l a0,-(sp) move.l a1,-(sp) bsr _affir move.l 4(sp),(sp) move.l a0,4(sp) bsr _divrr 6: move.l a2,4(sp) move.l d0,(sp) bsr _affrr addq.l #8,sp divzf: move.l (sp)+,_avma move.l (sp)+,a2 rts _divsrz: lea _divsr,a0 bra.w mpopz _divrsz: lea _divrs,a0 bra.w mpopz _divirz: lea _divir,a0 bra.w mpopz _divriz: lea _divri,a0 bra.w mpopz _divrrz: lea _divrr,a0 bra.w mpopz *===================================================================* * * * Division par valeur : entier / entier = entier ou reel * * * * entree : a7(4) contient i2 de type S * * a7(8) contient i1 de type S * * a7(12) pointe sur i3 ou r3 de type I ou R * * sortie : a7(12) pointe sur i2 / i1 de type I ou R * * * *===================================================================* _divssz: cmp.b #1,([12,sp]) bne.b _divssr _divssi: move.l 8(sp),-(sp) move.l 8(sp),-(sp) bsr _divss move.l 20(sp),4(sp) move.l d0,(sp) bsr _affii move.l (sp),a0 addq.l #8,sp bra.w _giv _divssr: move.l _avma,-(sp) move.w ([16,sp],2),d0 bsr _getr move.l a0,-(sp) move.l 12(sp),-(sp) bsr _affsr move.l 4(sp),(sp) move.l 20(sp),4(sp) bsr _divrs move.l 24(sp),4(sp) move.l d0,(sp) bsr _affrr addq.l #8,sp move.l (sp)+,_avma rts *===================================================================* * * * Division par valeur : S / I = entier ou reel * * * * entree : a7(4) contien i2 de type S * * a7(8) pointe sur i1 de type I * * a7(12) pointe sur i3 ou r3 de type I ou R * * sortie : a7(12) pointe sur i2 / i1 de type I ou R * * * *===================================================================* _divsiz: link a6,#0 movem.l a2-a4,-(sp) move.l 16(a6),a3 cmp.b #1,(a3) bne.b _divsir _divsii: move.l 12(a6),-(sp) move.l 8(a6),-(sp) bsr _divsi move.l 16(a6),4(sp) move.l d0,(sp) bsr _affii move.l (sp),a0 addq.l #8,sp bsr _giv divsizf: movem.l (sp)+,a2-a4 unlk a6 rts _divsir: move.l _avma,a2 move.w 2(a3),d0 addq.w #1,d0 bsr _getr move.l a0,a4 move.l a0,-(sp) move.l 8(a6),-(sp) bsr _affsr addq.l #2,d0 bsr _getr move.l a0,4(sp) move.l 12(a6),(sp) bsr _affir move.l a4,(sp) bsr _divrr move.l a3,4(sp) move.l d0,(sp) bsr _affrr addq.l #8,sp move.l a2,_avma bra.b divsizf *===================================================================* * * * Division par valeur : I / S = entier ou reel * * * * entree : a7(4) pointe sur i2 de type I * * a7(8) contient i1 de type S * * a7(12) pointe sur i3 ou r3 de type I ou R * * sortie : a7(12) pointe sur i2 / i1 de type I ou R * * * *===================================================================* _divisz: cmp.b #1,([12,sp]) bne.b _divisr _divisi: move.l 8(sp),-(sp) move.l 8(sp),-(sp) bsr _divis move.l 20(sp),4(sp) move.l d0,(sp) bsr _affii move.l (sp),a0 addq.l #8,sp bra.w _giv _divisr: move.l _avma,-(sp) move.w ([16,sp],2),d0 bsr _getr move.l a0,-(sp) move.l 12(sp),-(sp) bsr _affir move.l 4(sp),(sp) move.l 20(sp),4(sp) bsr _divrs move.l 24(sp),4(sp) move.l d0,(sp) bsr _affrr addq.l #8,sp move.l (sp)+,_avma rts *===================================================================* * * * Division par valeur : entier / entier = entier ou reel * * * * entree : a7(4) pointe sur i2 de type I * * a7(8) pointe sur i1 de type I * * a7(12) pointe sur i3 ou r3 de type I ou R * * sortie : a7(12) pointe sur i2 / i1 de type I ou R * * * *===================================================================* _diviiz: link a6,#0 movem.l a2-a4,-(sp) move.l 16(a6),a3 cmp.b #1,(a3) bne.b _diviir _diviii: move.l 12(a6),-(sp) move.l 8(a6),-(sp) bsr _divii move.l 16(a6),4(sp) move.l d0,(sp) bsr _affii move.l (sp),a0 addq.l #8,sp bsr _giv diviizf: movem.l (sp)+,a2-a4 unlk a6 rts _diviir: move.l _avma,a2 move.w 2(a3),d0 bsr _getr move.l a0,a4 move.l a0,-(sp) move.l 8(a6),-(sp) bsr _affir addq.l #2,d0 bsr _getr move.l a0,4(sp) move.l 12(a6),(sp) bsr _affir move.l a4,(sp) bsr _divrr move.l a3,4(sp) move.l d0,(sp) bsr _affrr addq.l #8,sp move.l a2,_avma bra.b diviizf *===================================================================* * * * Division : entier court / entier court = entier * * * * entree : a7(4) contient s2 de type S * * a7(8) contient s1 de type S * * sortie : d0 pointe sur s2 div s1 de type I (zone creee) * * d1.l contient le reste(du signe du dividende) * * * *===================================================================* _divss: link a6,#0 movem.l d2-d3,-(sp) moveq #0,d3 move.l 12(a6),d1 bne.b 1f move.l #23,-(sp) jsr _err 1: move.l 8(a6),d2 bpl.b 5f moveq #-1,d3 5: divs.l d1,d3:d2 bne.b 2f 3: move.l _gzero,d0 move.l d3,d1 bra.b divssg 2: moveq #3,d0 bsr _geti move.l #0x1000003,4(a0) tst.l d2 bpl.b 4f neg.l d2 move.b #-1,4(a0) 4: move.l d2,8(a0) move.l d3,d1 divssf: move.l a0,d0 divssg: movem.l (sp)+,d2-d3 unlk a6 rts *===================================================================* * * * Division : entier court / entier = entier * * * * entree : a7(4) contient s2 de type S * * a7(8) contient i1 de type I * * sortie : d0 pointe sur s2 div i1 de type I (zone creee) * * d1.l contient le reste (du signe du dividende) * * * *===================================================================* _divsi: link a6,#0 movem.l d2-d4,-(sp) move.l 12(a6),a1 tst.b 4(a1) bne.b 1f move.l #24,-(sp) jsr _err 1: move.l 8(a6),d2 bne.b 3f 2: move.l _gzero,d0 moveq #0,d1 bra.b divsig 3: move.w 6(a1),d1 cmp.w #3,d1 beq.b 4f 6: move.l _gzero,d0 move.l d2,d1 bra.b divsig 4: move.l 8(a1),d1 move.l d2,d3 bpl.b 5f neg.l d3 5: moveq #0,d4 divu.l d1,d4:d3 beq.b 6b moveq #3,d0 bsr _geti move.l d3,8(a0) move.l 4(a1),4(a0) tst.l d2 bpl.b 7f move.b #-1,4(a0) 7: move.l d4,d1 tst.b 4(a1) bpl.b divsif neg.l d1 divsif: move.l a0,d0 divsig: movem.l (sp)+,d2-d4 unlk a6 rts *===================================================================* * * * Division : entier court / reel = reel * * * * entree : a7(4) contient s2 de type S * * a7(8) pointe sur r1 de type R * * sortie : d0 pointe sur s2 / r1 de type R (zone creee) * * * *===================================================================* _divsr: link a6,#-32 movem.l d2/a2-a4,-(sp) move.l 12(a6),a1 tst.b 4(a1) bne.b 2f move.l #25,-(sp) jsr _err 2: tst.l 8(a6) bne.b 1f move.l _gzero,d0 bra.b divsrf 1: moveq #0,d0 move.w 2(a1),d0 bsr _getr move.l 8(a6),d2 move.l a0,a4 addq.w #1,d0 bsr _getr move.l a0,-(sp) move.l d2,-(sp) bsr _affsr addq.l #4,sp move.l a0,a2 move.l a4,a0 bsr dvrr move.l (sp)+,a0 bsr _giv move.l a4,d0 divsrf: movem.l (sp)+,d2/a2-a4 unlk a6 rts *===================================================================* * * * Division : entier / entier court = entier * * * * entree : a7(4) pointe sur i2 de type I * * a7(8) contient s1 de type S * * sortie : d0 pointe sur i2 / s1 de type I (zone creee) * * le reste est dans d1.l (du signe du dividende) * * * *===================================================================* _divis: link a6,#0 movem.l d2-d6/a2,-(sp) move.l 12(a6),d1 bne.b 1f move.l #26,-(sp) jsr _err 1: bpl.b 2f neg.l d1 2: move.l 8(a6),a2 move.w 6(a2),d2 move.w 4(a2),d5 bne.b 4f 3: move.l _gzero,d0 moveq #0,d1 bra.b divisg 4: move.w d2,d0 addq.l #8,a2 move.l (a2)+,d4 moveq #0,d3 divu.l d1,d3:d4 bne.b 5f subq.w #1,d0 cmp.w #2,d0 bne.b 5f move.l _gzero,a0 bra.b L1008 5: bsr _geti move.l a0,a1 move.w d0,6(a0) move.b #1,4(a0) move.w 12(a6),d6 eor.w d5,d6 bpl.b 6f move.b #-1,4(a0) 6: addq.l #8,a1 tst.l d4 beq.b 7f move.l d4,(a1)+ 7: subq.w #3,d2 bra.b 9f 8: move.l (a2)+,d4 divu.l d1,d3:d4 move.l d4,(a1)+ 9: dbra d2,8b L1008: move.l d3,d1 tst.w d5 bpl.b divisf neg.l d1 divisf: move.l a0,d0 divisg: movem.l (sp)+,d2-d6/a2 unlk a6 rts *===================================================================* * * * Division : entier / entier = entier * * * * entree : a7(4) pointe sur i2 de type I * * a7(8) pointe sur i1 de type I * * sortie : d0 pointe sur i2 / i1 de type I (zone creee) * * Le reste est du signe du dividende * * * *===================================================================* _divii: clr.l -(sp) move.l 12(sp),-(sp) move.l 12(sp),-(sp) bsr _dvmdii lea 12(sp),sp rts *===================================================================* * * * Division : entier / reel = reel * * * * entree : a7(4) pointe sur i2 de type I * * a7(8) pointe sur r1 de type R * * sortie : d0 pointe sur i2 / r1 de type R (zone creee) * * * *===================================================================* _divir: link a6,#-32 movem.l a2-a3,-(sp) move.l 12(a6),a1 tst.b 4(a1) bne.b 1f move.l #27,-(sp) jsr _err 1: move.l 8(a6),a2 tst.b 4(a2) bne.b 2f move.l _gzero,d0 bra.b divirf 2: moveq #0,d0 move.w 2(a1),d0 bsr _getr move.l a0,a3 addq.w #1,d0 bsr _getr move.l a0,-16(a6) move.l a0,-(sp) move.l a2,-(sp) bsr _affir addq.l #8,sp move.l a0,a2 move.l a3,a0 bsr dvrr move.l -16(a6),a0 bsr _giv move.l a3,d0 divirf: movem.l (sp)+,a2-a3 unlk a6 rts *===================================================================* * * * Division : reel / entier court = reel * * * * entree : a7(4) pointe sur r2 de type R * * a7(8) pointe sur s1 de type S * * sortie : d0 pointe sur r2 / s1 de type R (zone creee) * * * *===================================================================* _divrs: link a6,#0 movem.l d2-d6/a2,-(sp) move.l 12(a6),d1 bne.b 1f move.l #28,-(sp) jsr _err 1: move.l 8(a6),a2 tst.b 4(a2) bne.b 2f moveq #3,d0 bsr _getr tst.l d1 bpl.b L1109 neg.l d1 L1109: bfffo d1{0:32},d0 add.l 4(a2),d0 sub.l #31,d0 bmi.w 9f move.l d0,4(a0) clr.l 8(a0) bra.w divrsf 2: move.w 2(a2),d0 bsr _getr move.b 4(a2),4(a0) tst.l d1 bpl.b 3f neg.l d1 neg.b 4(a0) 3: move.l a0,a1 addq.l #8,a1 addq.l #8,a2 subq.w #3,d0 move.l d0,d2 moveq #0,d3 4: move.l (a2)+,d4 divu.l d1,d3:d4 move.l d4,(a1)+ dbra d0,4b move.l 8(a0),d0 bpl.b L1009 moveq #0,d1 bra.b 5f L1009: moveq #0,d4 divu.l d1,d3:d4 bfffo d0{0:32},d1 lsl.l d1,d0 move.l a0,a1 addq.l #8,a1 moveq #1,d6 lsl.l d1,d6 subq.l #1,d6 bra.b 7f 6: move.l 4(a1),d3 rol.l d1,d3 move.l d3,d5 and.l d6,d3 add.l d3,d0 move.l d0,(a1)+ sub.l d3,d5 move.l d5,d0 7: dbra d2,6b rol.l d1,d4 and.l d6,d4 add.l d4,d0 move.l d0,(a1) 5: move.l 8(a6),a2 move.l 4(a2),d2 and.l #0xffffff,d2 sub.l d1,d2 bpl.b 8f 9: move.l #29,-(sp) jsr _err 8: move.w d2,6(a0) swap d2 move.b d2,5(a0) divrsf: move.l a0,d0 movem.l (sp)+,d2-d6/a2 unlk a6 rts *===================================================================* * * * Division : reel / entier = reel * * * * entree : a7(4) pointe sur r2 de type R * * a7(8) pointe sur i1 de type I * * sortie : d0 pointe sur r2 / i1 de type R (zone creee) * * * *===================================================================* _divri: link a6,#-32 movem.l d2-d3/a2-a3,-(sp) move.l 12(a6),a1 tst.b 4(a1) bne.b 1f move.l #30,-(sp) jsr _err 1: move.l 8(a6),a2 tst.b 4(a2) bne.b 2f moveq #3,d0 bsr _getr move.w 6(a1),d0 lsl.l #5,d0 bfffo 8(a1){0:32},d1 add.l 4(a2),d1 add.l #65,d1 sub.l d0,d1 bpl.b 3f move.l #34,-(sp) jsr _err 3: move.l d1,4(a0) clr.l 8(a0) move.l a0,d0 bra.b divrif 2: moveq #0,d0 move.w 2(a2),d0 bsr _getr move.l _avma,a3 subq.l #8,a3 move.l a3,_avma move.l #2,(a3) move.l a0,a3 addq.w #1,d0 bsr _getr move.l a0,-16(a6) move.l a0,-(sp) move.l a1,-(sp) bsr _affir addq.l #8,sp move.l a0,a1 move.l a3,a0 bsr dvrr move.l -16(a6),a0 bsr _giv move.l a3,d0 divrif: movem.l (sp)+,d2-d3/a2-a3 unlk a6 rts *===================================================================* * * * Division : reel / reel = reel * * * * entree : a7(4) pointe sur r2 de type R * * a7(8) pointe sur r1 de type R * * sortie : d0 pointe sur r2 / r1 de type R (zone creee) * * precision : L = inf ( L1 , L2 ) * * * *===================================================================* _divrr: link a6,#-32 move.l a2,-(sp) move.l 12(a6),a1 move.l 8(a6),a2 tst.b 4(a1) bne.b 1f move.l #31,-(sp) jsr _err 1: tst.b 4(a2) bne.b 3f moveq #3,d0 bsr _getr move.l 4(a1),d0 and.l #0xffffff,d0 sub.l 4(a2),d0 neg.l d0 add.l #0x800000,d0 cmp.l #0x1000000,d0 bcs.b 4f move.l #33,-(sp) jsr _err 4: tst.l d0 bgt.b 5f move.l #32,-(sp) jsr _err 5: move.l d0,4(a0) clr.l 8(a0) bra.b divrrf 3: move.w 2(a1),d0 cmp.w 2(a2),d0 bls.b 2f move.w 2(a2),d0 2: bsr _getr bsr dvrr divrrf: move.l a0,d0 move.l (sp),a2 unlk a6 rts *===================================================================* * * * module interne de division r/r (pour R/R,R/I,I/R et S/R) * * -------------------------------------------------------- * * entree : a1 et a2 pointent sur 2 reels r1 et r2 * * tous 2 non nuls. * * a0 pointe sur un type reel de longueur l=inf(l1,l2) * * ce module a besoin de variable.bs locales reservees et * * pointees par a6 dans le programme appelant. * * sortie : le quotient r2/r1 est mis a l'addresse initiale a0 * * (qui n'est pas affectee) * *===================================================================* dvrr: movem.l d2-d7/a2-a4,-(sp) move.b 4(a1),d1 move.b 4(a2),d2 eor.b d2,d1 addq.b #1,d1 move.b d1,-2(a6) move.l 4(a2),d2 and.l #0xffffff,d2 move.l 4(a1),d1 and.l #0xffffff,d1 sub.l d1,d2 add.l #0x800000,d2 move.l d2,-6(a6) move.w 2(a0),d0 move.w 2(a1),d1 cmp.w #3,d1 bne.b 5f move.l 8(a1),d1 move.l 8(a2),d3 clr.l d2 cmp.w #3,2(a2) beq.b 7f move.l 12(a2),d2 7: cmp.l d3,d1 bls 6f divu.l d1,d3:d2 move.l d2,8(a0) move.l -6(a6),d0 subq.l #1,d0 bra.w comd2 6: lsr.l #1,d3 roxr.l #1,d2 divu.l d1,d3:d2 move.l d2,8(a0) move.l -6(a6),d0 bra.w comd2 5: sub.w d0,d1 move.w d1,-28(a6) subq.w #2,d0 move.w d0,d7 move.w d7,-12(a6) move.l (a0),-10(a6) move.w 2(a2),d6 subq.w #2,d6 addq.l #8,a2 move.l a0,a4 clr.l (a4)+ 1: move.l (a2)+,(a4)+ dbra d0,1b cmp.w d7,d6 bgt.b 4f clr.l -4(a4) 4: move.l a0,a2 addq.l #8,a1 lea (8,a1,d7.w*4),a3 move.l a3,-32(a6) move.w -28(a6),d6 bne.b 2f move.l -8(a3),-20(a6) clr.l -8(a3) 2: subq.w #1,d6 bgt.b 3f move.l -4(a3),-24(a6) clr.l -4(a3) 3: moveq #0,d6 *...................................................................* dext: move.l (a1),d0 cmp.l (a2),d0 bne.b 1f move.l #-1,d1 add.l 4(a2),d0 bcs.b 4f move.l d0,d2 bra.b 2f 1: move.l (a2),d2 move.l 4(a2),d1 divu.l d0,d2:d1 2: move.l 4(a1),d3 mulu.l d1,d4:d3 sub.l 8(a2),d3 subx.l d2,d4 bls.b 4f 3: subq.l #1,d1 sub.l 4(a1),d3 subx.l d0,d4 bhi.b 3b 4: move.w d7,d0 move.l a3,a1 move.l a4,a2 move.l -(a1),d2 mulu.l d1,d3:d2 sub.l d2,d2 5: move.l -(a1),d5 mulu.l d1,d4:d5 addx.l d3,d5 addx.l d2,d4 sub.l d5,-(a2) move.l d4,d3 dbra d0,5b addx.l d2,d3 sub.l d3,-4(a2) bcc.b 6f subq.l #1,d1 move.w d7,d0 move.l a3,a1 move.l a4,a2 subq.l #4,a1 7: addx.l -(a1),-(a2) dbra d0,7b 6: move.l d1,-4(a2) subq.l #4,a3 bcdf: dbra d7,dext *...................................................................* move.l -32(a6),a3 move.w -28(a6),d5 bne.b 7f move.l -20(a6),-8(a3) 7: subq.w #1,d5 bgt.b 8f move.l -24(a6),-4(a3) 8: move.w -12(a6),d5 move.w d5,d4 6: move.l -(a2),4(a2) dbra d5,6b move.l -10(a6),(a2)+ move.l -6(a6),d0 move.l (a2),d1 bne.b 1f subq.l #1,d0 bra.b comd2 1: addq.l #4,a2 subq.w #1,d4 asr.w #1,d1 5: roxr.w (a2)+ roxr.w (a2)+ dbra d4,5b comd2: cmp.l #0x1000000,d0 ble.b 3f move.l #32,-(sp) jsr _err 3: bcs.b 4f move.l #33,-(sp) jsr _err 4: move.l d0,4(a0) move.b -2(a6),4(a0) movem.l (sp)+,d2-d7/a2-a4 dvrrf: rts ********************************************************************* ********************************************************************* *** *** *** PROGRAMMES D ' INVERSION *** *** ( programmes par valeurs : le resultat est *** ** mis dans un REEL existant deja ) *** *** *** ********************************************************************* ********************************************************************* _mpinvsr: move.l 8(sp),-(sp) move.l 8(sp),-(sp) pea 1 bsr _divssr lea 12(sp),sp rts _mpinvz: cmp.b #1,([4,sp]) bne.b _mpinvrr _mpinvir: move.l 8(sp),-(sp) move.l 8(sp),-(sp) pea 1 bsr _divsiz lea 12(sp),sp rts _mpinvrr: move.l 8(sp),-(sp) move.l 8(sp),-(sp) pea 1 bsr _divsrz lea 12(sp),sp rts ********************************************************************* ********************************************************************* *** *** *** PROGRAMMES MODULO *** *** *** ********************************************************************* ********************************************************************* *===================================================================* * * * Modulo (par valeur) * * * * entree : a7(4) pointe sur n2 de type I * * a7(8) pointe sur n1 de type I * * a7(12) pointe sur n3 de type I * * sortie : la zone pointee par a7(12) contient le reste de * * la division de n2 par n1 * * compris entre 0 et abs(n1)-1 * * interdit : type S et R * * * *===================================================================* _mpmodz: lea _modii,a0 bra.w mpopi _modssz: lea _modss,a0 bra.w mpopi _modsiz: lea _modsi,a0 bra.w mpopi _modisz: lea _modis,a0 bra.w mpopi _modiiz: lea _modii,a0 bra.w mpopi *===================================================================* * * * entier court Modulo entier court = entier * * * * entree : a7(4) contient s2 de type S * * a7(8) contient s1 de type S * * sortie : d0 pointe sur s2 mod s1 de type I (zone creee) * * compris entre 0 et abs(s1)-1 * * * *===================================================================* _modss: link a6,#0 movem.l d2-d3,-(sp) moveq #0,d3 move.l 12(a6),d1 bne.b 1f move.l #38,-(sp) jsr _err 1: move.l 8(a6),d2 bpl.b 8f moveq #-1,d3 8: divs.l d1,d3:d2 tst.l d3 bne.b 2f 3: move.l _gzero,d0 bra.b modssf 2: bmi.b 5f moveq #3,d0 bsr _geti move.l #0x1000003,4(a0) move.l d3,8(a0) bra.b 7f 5: move.l 12(a6),-(sp) move.l d3,-(sp) tst.l d1 bpl.b 6f bsr _subss addq.l #8,sp bra.b modssf 6: bsr _addss addq.l #8,sp bra.b modssf 7: move.l a0,d0 modssf: movem.l (sp)+,d2-d3 unlk a6 rts *===================================================================* * * * entier court Modulo entier = entier * * * * entree : a7(4) contient s2 de type S * * a7(8) ppinte sur i1 de type I * * sortie : d0 pointe sur s2 mod i1 de type I (zone creee) * * compris entre 0 et abs(i1)-1 * * * *===================================================================* _modsi: link a6,#0 movem.l d2-d3,-(sp) move.l 12(a6),-(sp) move.l 8(a6),-(sp) bsr _divsi addq.l #8,sp move.l d0,a0 bsr _giv tst.l d1 bne.b 1f move.l _gzero,d0 bra.b modsif 1: bmi.b 3f move.l d1,d3 moveq #3,d0 bsr _geti move.l #0x1000003,4(a0) move.l d3,8(a0) bra.b 2f 3: move.l 12(a6),-(sp) move.l d1,-(sp) move.l 12(a6),a1 tst.b 4(a1) bpl.b 5f bsr _subsi bra.b 6f 5: bsr _addsi 6: addq.l #8,sp bra.b modsif 2: move.l a0,d0 modsif: movem.l (sp)+,d2-d3 unlk a6 rts *===================================================================* * * * entier Modulo entier court = entier * * * * entree : a7(4) pointe sur i2 de type I * * a7(8) contient s1 de type S * * sortie : d0 pointe sur i2 mod s1 de type I (zone creee) * * compris entre 0 et abs(s1)-1 * * * *===================================================================* _modis: link a6,#0 movem.l d2-d3,-(sp) move.l 12(a6),-(sp) move.l 8(a6),-(sp) bsr _divis addq.l #8,sp move.l d0,a0 bsr _giv tst.l d1 bne.b 1f move.l _gzero,d0 bra.b modisf 1: bmi.b 3f move.l d1,d3 moveq #3,d0 bsr _geti move.l #0x1000003,4(a0) move.l d3,8(a0) bra.b 2f 3: move.l 12(a6),-(sp) move.l d1,-(sp) move.l 12(a6),d1 bpl.b 5f bsr _subss bra.b 6f 5: bsr _addss 6: addq.l #8,sp bra.b modisf 2: move.l a0,d0 modisf: movem.l (sp)+,d2-d3 unlk a6 rts *===================================================================* * * * entier Modulo entier = entier * * * * entree : a7(4) pointe sur i2 de type I * * a7(8) pointe sur i1 de type I * * sortie : d0 pointe sur i2 mod i1 de type I * * compris entre 0 et abs(i1)-1(zone creee) * * * *===================================================================* _modii: link a6,#-4 move.l #-1,-(sp) move.l 12(a6),-(sp) move.l 8(a6),-(sp) move.l _avma,-4(a6) bsr _dvmdii move.l d0,a1 tst.b 4(a1) bpl.b modiif move.l a1,(sp) tst.b ([12,a6],4) bpl.b 1f bsr _subii bra.b 2f 1: bsr _addii 2: move.l (sp)+,a1 move.l _avma,a0 move.w 2(a0),d0 subq.w #1,d0 move.l -4(a6),a0 3: move.l -(a1),-(a0) dbra d0,3b move.l a0,_avma move.l a0,d0 modiif: unlk a6 rts ********************************************************************* ********************************************************************* *** *** *** PROGRAMMES DE RESTE DES DIVISIONS ENTIERES *** *** *** ********************************************************************* ********************************************************************* *===================================================================* * * * Reste (par valeur) * * * * entree : a7(4) pointe sur n2 de type I * * a7(8) pointe sur n1 de type I * * a7(12) pointe sur n3 de type I * * sortie : la zone pointee par a7(12) contient le reste de * * la division de n2 par n1 (du signe du dividende) * * interdit : type S et R * * * *===================================================================* _mpresz: lea _resii,a0 bra.w mpopi _resssz: lea _resss,a0 bra.w mpopi _ressiz: lea _ressi,a0 bra.w mpopi _resisz: lea _resis,a0 bra.w mpopi _resiiz: lea _resii,a0 bra.w mpopi *===================================================================* * * * Reste : entier court / entier court = entier * * * * entree : a7(4) contient s2 de type S * * a7(8) contient s1 de type S * * sortie : d0 pointe sur le reste de la division s2 / s1 * * de type I (zone creee) * * Le reste est du signe du dividende * * * *===================================================================* _resss: link a6,#0 movem.l d2-d3,-(sp) moveq #0,d3 move.l 12(a6),d1 bne.b 1f move.l #40,-(sp) jsr _err 1: move.l 8(a6),d2 bpl.b 4f moveq #-1,d3 4: divs.l d1,d3:d2 tst.l d3 bne.b 2f move.l _gzero,d0 bra.b resssg 2: moveq #3,d0 bsr _geti move.l #0x1000003,4(a0) tst.l d3 bpl.b 3f neg.l d3 move.b #-1,4(a0) 3: move.l d3,8(a0) resssf: move.l a0,d0 resssg: movem.l (sp)+,d2-d3 unlk a6 rts *===================================================================* * * * Reste : entier court / entier = entier * * * * entree : a7(4) contient s2 de type S * * a7(8) pointe sur i1 de type I * * sortie : d0 pointe sur le reste de la division s2 / i1 * * de type I (zone creee) * * Le reste est du signe du dividende * * * *===================================================================* _ressi: move.l 8(sp),-(sp) move.l 8(sp),-(sp) bsr _divsi move.l d0,a0 bsr _giv tst.l d1 bne.b 1f move.l _gzero,d0 bra.b ressig 1: moveq #3,d0 bsr _geti move.l #0x1000003,4(a0) tst.l d1 bpl.b 2f neg.l d1 move.b #-1,4(a0) 2: move.l d1,8(a0) ressif: move.l a0,d0 ressig: addq.l #8,sp rts *===================================================================* * * * Reste : entier / entier court = entier * * * * entree : a7(4) pointe sur i2 de type I * * a7(8) contient s1 de type S * * sortie : d0 pointe sur le reste de la division i2 / s1 * * (zone creee) * * Le reste est du signe du dividende * * * *===================================================================* _resis: move.l 8(sp),-(sp) move.l 8(sp),-(sp) bsr _divis move.l d0,a0 bsr _giv tst.l d1 bne.b 1f move.l _gzero,d0 bra.b resisg 1: moveq #3,d0 bsr _geti move.l #0x1000003,4(a0) tst.l d1 bpl.b 2f neg.l d1 move.b #-1,4(a0) 2: move.l d1,8(a0) resisf: move.l a0,d0 resisg: addq.l #8,sp rts *===================================================================* * * * Reste : entier / entier = entier * * * * entree : a7(4) pointe sur i2 de type I * * a7(8) pointe sur i1 de type I * * sortie : d0 pointe sur le reste de la division i2 / i1 * * de type I (zone creee) * * ( du signe du dividende) * * * *===================================================================* _resii: move.l #-1,-(sp) move.l 12(sp),-(sp) move.l 12(sp),-(sp) bsr _dvmdii lea 12(sp),sp rts *===================================================================* * * * Operations par valeur * * * * entree : a7(4) contient n2 de type S ou pointe sur n2 * * de type I ou R * * a7(8) contient n1 de type S ou pointe sur n1 * * de type I ou R * * a7(12) pointe sur n3 de type I ou R * * sortie : la zone pointee par a7(12) contient n2 op n1 * * remarque : les erreurs de type sont detectees dans l' * * affectation du resultat * * * *===================================================================* mpariz: move.b ([12,sp]),d0 add.b ([8,sp]),d0 add.b ([4,sp]),d0 cmp.b #3,d0 beq.b mpopz move.l #42,-(sp) jsr _err mpopi: cmp.b #1,([12,sp]) beq.b mpopz move.l #43,-(sp) jsr _err mpopz: move.l 8(sp),-(sp) move.l 8(sp),-(sp) jsr (a0) move.l 20(sp),4(sp) move.l d0,(sp) jsr _mpaff addq.l #8,sp move.l d0,a0 bra.w _giv mpopii: move.b ([16,sp]),d0 add.b ([12,sp]),d0 cmp.b #2,d0 beq.b mpopz2 move.l #43,-(sp) jsr _err mpopz2: link a6,#-8 move.l _avma,-8(a6) pea -4(a6) move.l 12(a6),-(sp) move.l 8(a6),-(sp) jsr (a0) addq.l #4,sp move.l -4(a6),(sp) move.l 20(a6),4(sp) bsr _mpaff move.l d0,(sp) move.l 16(a6),4(sp) bsr _mpaff addq.l #8,sp move.l -8(a6),_avma unlk a6 rts ********************************************************************* ********************************************************************* *** *** *** PROGRAMMES PAR VALEUR UTILISES POUR LA LECTURE-ECRITURE *** *** *** ********************************************************************* ********************************************************************* *===================================================================* * * * Multiplication par valeur : entier court * entier = entier * * * * entree : a7(4) contient s2 de type S * * a7(8) pointe sur i1 de type I * * a7(12) pointe sur i3 de type I * * sortie : i3 pointe sur s2 * i1 * * * *===================================================================* _mulsii: move.l 8(sp),-(sp) move.l 8(sp),-(sp) bsr _mulsi move.l 20(sp),4(sp) move.l d0,(sp) bsr _affii move.l (sp),a0 addq.l #8,sp bra.w _giv *===================================================================* * * * Addition par valeur : entier court + entier = entier * * * * entree : a7(4) contient s2 de type S * * a7(8) pointe sur i1 de type I * * a7(12) pointe sur i3 de type I * * sortie : i3 pointe sur s2 + i1 * * * *===================================================================* _addsii: move.l 8(sp),-(sp) move.l 8(sp),-(sp) bsr _addsi move.l 20(sp),4(sp) move.l d0,(sp) bsr _affii move.l (sp),a0 addq.l #8,sp bra.w _giv *===================================================================* * * * division I / S = I * * * * entree: a7(4) pointe sur i2, a7(8) contient s1 * * a7(12) pointe sur un type I * * sortie: a7(12) pointe sur i2 div s1 * * d1 contient i2 mod s1 * * * *===================================================================* _divisii: move.l 8(sp),-(sp) move.l 8(sp),-(sp) bsr _divis move.l 20(sp),4(sp) move.l d0,(sp) bsr _affii move.l (sp),a0 addq.l #8,sp bra.w _giv *===================================================================* * * * Conversion type I --> base 10^9 * * * * entree : a7(4) pointe sur un type I * * sortie : le resultat recoit I converti en base 10^9, * * sans signe, avec un -1 artificiel au debut * * d0 pointe apres la zone du resultat * * * *===================================================================* _convi: link a6,#0 movem.l d2/a2-a3,-(sp) move.l _avma,d2 move.l 8(a6),-(sp) bsr _absi move.l d0,a3 move.w 6(a3),d0 subq.w #2,d0 mulu #15,d0 divu #14,d0 addq.w #3,d0 bsr _geti move.l a0,a2 addq.l #4,a2 move.l #-1,(a2)+ move.l a3,-(sp) move.l #1000000000,-(sp) move.l a3,-(sp) tst.b 4(a3) bne.b 1f clr.l (a2)+ bra.b 2f 1: bsr _divisii move.l d1,(a2)+ tst.b 4(a3) bne.b 1b 2: lea 16(sp),sp move.l a2,d0 move.l d2,_avma movem.l (sp)+,d2/a2-a3 unlk a6 convif: rts *===================================================================* * * * Conversion partie fractionnaire --> base 10^9 * * * * entree : a7(4) pointe sur un type R de module < 1 * * sortie : le resultat en base 10^9 precede par nb de dec. * * d0 pointe sur le resultat * * * *===================================================================* _confrac: link a6,#-12 movem.l d2-d7/a2-a3,-(sp) move.l _avma,-8(a6) move.l 8(a6),a1 clr.l d0 move.w 2(a1),d0 move.l 4(a1),d1 and.l #0xffffff,d1 sub.l #0x800000,d1 not.l d1 move.l d1,d7 subq.l #2,d0 lsl.l #5,d0 add.l d1,d0 move.l d0,d2 add.l #95,d0 lsr.l #5,d0 bsr _geti move.l d0,-4(a6) lsr.l #5,d7 move.l a0,a2 bra.b 1f 2: clr.l (a0)+ 1: dbra d7,2b move.w 2(a1),d3 subq.l #3,d3 addq.l #8,a1 and.l #31,d1 bne.b 3f 4: move.l (a1)+,(a0)+ dbra d3,4b bra.b 5f 3: moveq #-1,d6 lsr.l d1,d6 moveq #0,d4 6: move.l (a1)+,d0 ror.l d1,d0 move.l d0,d5 and.l d6,d5 sub.l d5,d0 add.l d4,d5 move.l d5,(a0)+ move.l d0,d4 dbra d3,6b move.l d4,(a0)+ 5: clr.l (a0) mulu.l #8651,d3:d2 divu.l #28738,d3:d2 move.l d2,d0 addq.l #1,d0 move.l d0,d7 add.l #17,d0 divu #9,d0 bsr _geti move.l a0,-12(a6) move.l d7,(a0)+ subq.w #2,d0 move.l -4(a6),d1 lea (a2,d1.w*4),a2 subq.l #1,d1 move.l a2,a3 move.l d1,d3 move.l #1000000000,d6 clr.l d7 boext: clr.l d2 1: move.l -(a2),d5 mulu.l d6,d4:d5 add.l d2,d5 addx.l d7,d4 move.l d5,(a2) move.l d4,d2 dbra d1,1b move.l d2,(a0)+ move.l a3,a2 move.l d3,d1 dbra d0,boext move.l -12(a6),d0 movem.l (sp)+,d2-d7/a2-a3 move.l -8(a6),_avma unlk a6 rts