home *** CD-ROM | disk | FTP | other *** search
Text File | 1991-08-07 | 164.1 KB | 6,761 lines |
- *********************************************************************
- *===================================================================*
- ** **
- *= =*
- ** **
- *= 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. *
- * *
- *-------------------------------------------------------------------*
-
-
-
-
-
- affer1 EQU 1
- affer2 EQU 2
- affer3 EQU 3
- affer4 EQU 4
- affer5 EQU 5
- exger1 EQU 6
- exger2 EQU 7
- shier1 EQU 8
- shier2 EQU 9
- truer1 EQU 10
- truer2 EQU 11
- adder1 EQU 12
- adder2 EQU 13
- adder3 EQU 14
- adder4 EQU 15
- adder5 EQU 16
- muler1 EQU 17
- muler2 EQU 18
- muler3 EQU 19
- muler4 EQU 20
- muler5 EQU 21
- muler6 EQU 22
- diver1 EQU 23
- diver2 EQU 24
- diver3 EQU 25
- diver4 EQU 26
- diver5 EQU 27
- diver6 EQU 28
- diver7 EQU 29
- diver8 EQU 30
- diver9 EQU 31
- diver10 EQU 32
- diver11 EQU 33
- diver12 EQU 34
- divzer1 EQU 35
- dvmer1 EQU 36
- dvmzer1 EQU 37
- moder1 EQU 38
- modzer1 EQU 39
- reser1 EQU 40
- reszer1 EQU 41
- arier1 EQU 42
- arier2 EQU 43
- errpile EQU 44
- rtodber EQU 45
- gerper EQU 46
-
- MACHINE MC68020
-
- cseg
-
- PUBLIC _avma,_top,_bot,_lontyp,_err
- XDEF _typ,_lg,_lgef,_mant,_signe,_expo,_pere,_valp,_precp,_varn
- XDEF _settyp,_setlg,_setlgef,_setmant,_setsigne,_setexpo,_expi
- XDEF _setpere,_incpere,_setvalp,_setprecp,_setvarn
- XDEF _cget,_cgetg,_cgeti,_cgetr,_cgiv,_gerepile
- XDEF _mpaff,_affsz,_affsi,_affsr,_affii,_affir
- XDEF _affrs,_affri,_affrr
- XDEF _stoi,_itos
- XDEF _mpneg,_mpnegz,_negs,_negi,_negr
- XDEF _mpabs,_mpabsz,_abss,_absi,_absr
- XDEF _mptrunc,_mptruncz,_mpent,_mpentz
- XDEF _mpexg,_vals,_vali
- XDEF _mpshift,_mpshiftz,_shifts,_shifti,_shiftr
- XDEF _mpcmp,_cmpss,_cmpsi,_cmpsr,_cmpis,_cmpii,_cmpir
- XDEF _cmprs,_cmpri,_cmprr
- XDEF _mpadd,_addss,_addsi,_addsr,_addii,_addir,_addrr
- XDEF _mpaddz,_addssz,_addsiz,_addsrz,_addiiz,_addirz,_addrrz
- XDEF _mpsub,_subss,_subsi,_subsr,_subis,_subii,_subir
- XDEF _subrs,_subri,_subrr
- XDEF _mpsubz,_subssz,_subsiz,_subsrz,_subisz,_subiiz,_subirz
- XDEF _subrsz,_subriz,_subrrz
- XDEF _mpmul,_mulss,_mulmodll,_mulsi,_mulsr,_mulii,_mulir,_mulrr
- XDEF _mpmulz,_mulssz,_mulsiz,_mulsrz,_muliiz,_mulirz,_mulrrz
- XDEF _dvmdss,_dvmdsi,_dvmdis,_dvmdii
- XDEF _mpdvmdz,_dvmdssz,_dvmdsiz,_dvmdisz,_dvmdiiz
- XDEF _mpdiv,_divss,_divsi,_divsr,_divis,_divii,_divir
- XDEF _divrs,_divri,_divrr
- XDEF _mpdivis,_divise
- XDEF _mpdivz,_divssz,_divsiz,_divsrz,_divisz,_diviiz,_divirz
- XDEF _divrsz,_divriz,_divrrz
- XDEF _mpinvz,_mpinvsr,_mpinvir,_mpinvrr
- XDEF _modss,_modsi,_modis,_modii
- XDEF _mpmodz,_modssz,_modsiz,_modisz,_modiiz
- XDEF _resss,_ressi,_resis,_resii
- XDEF _mpresz,_resssz,_ressiz,_resisz,_resiiz
- XDEF _convi,_confrac
- XDEF _addsii,_mulsii,_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.s _get
- move.l a0,d0
- rts
-
- _cgetg move.l 8(sp),d0 ; a7@(8) contient le type
- ror.l #8,d0
- move.w 6(sp),d0
- bsr.s _get
- move.l a0,d0
- rts
-
- _cgeti move.l 4(sp),d0
- bsr.s _geti
- move.l a0,d0
- rts
-
- _cgetr move.l 4(sp),d0
- bsr.s _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 *
- * *
- *===================================================================*
-
- ; allocation memoire type qcque
-
- _get move.l d1,-(sp) ; d0.l contient code et longueur
- moveq #0,d1
- move.w d0,d1
- lsl.l #2,d1
- move.l _avma,a0
- sub.l d1,a0
- cmp.l _bot,a0
- bmi.s mnet
- move.l a0,_avma
- swap d0
- move.b #1,d0
- swap d0
- move.l d0,(a0)
- move.l (sp)+,d1
- rts
-
- ; allocation memoire de type I
-
- _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.s mnet
- move.l a0,_avma
- move.w #$101,(a0)
- move.w d0,2(a0)
- move.l (sp)+,d1
- rts
-
- ; allocation memoire type R
-
- _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.s mnet
- move.l a0,_avma
- move.w #$201,(a0)
- move.w d0,2(a0)
- move.l (sp)+,d1
- rts
-
- ; nettoyage pile PARI
- ; a ecrire .....!!!!!!!!!
- mnet move.l #errpile,-(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 ; est suivi par giv
-
-
- *===================================================================*
- * *
- * 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 #$ff,1(a0) ; comparaison nb peres avec 255
- beq.s givf
- ; ici le nb de peres est non sature
- cmp.l _avma,a0
- beq.s giv1
- ; ici diminuer le nb de peres de 1
- sub.b #1,1(a0)
- givf move.l (sp)+,d0
- rts
- ; ici la zone est en tete de pile
- giv1 sub.b #1,1(a0)
- bne.s givf
- ; ici on desalloue la zone
- 1$ move.w 2(a0),d0
- lea 0(a0,d0.w*4),a0; a0 pointe sur zone suivante
- move.l a0,_avma
- tst.b 1(a0)
- beq.s 1$ ; aller desallouer zone suivante
- bra.s givf ; si zone suivante a un seul pere
- ; ou si a0 = top memoire ( cf init)
-
- *~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*
- * *
- * 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 ; l adresse fin de la zone a detruire
- move.l d2,a0
- move.l d2,d4
- move.l 36(sp),d1 ; p adresse deb de la zone a detruire
- move.l d1,a1
- move.l d1,d0
- sub.l d0,d2 ; decalage ( en octets ) = l - p
- bhi.s 10$ ; si l <= p rien a faire
- move.l 40(sp),d0
- bra.s 9$
- 10$ sub.l d5,d1
- lsr.l #2,d1 ; nb de lg mots a decaler
- bra.s 2$
- 1$ move.l -(a1),-(a0)
- 2$ dbra d1,1$ ; boucle de decalage
- sub.l #$10000,d1
- bge.s 1$
- move.l a0,_avma ; nouvel _avma et debut zone recopiee
- clr.l d3
- lea _lontyp,a3 ; tableau des types
- *---------------------------------| mise a jour de la zone recopiee :
- ; d4 pointe debut zone recopiee
- ; a0 pointe apres fin zone recopiee
- 3$ move.b (a0),d3 ; type de la zone examinee
- move.l 0(a3,d3.w*4),d1 ; d1 recoit _lontyp[typ(l1)]
- lea 0(a0,d1.l*4),a1 ; a1 pointe sur le dernier mot code
- move.w 2(a0),d1 ; longueur de la zone examinee
- move.l a0,a2
- lea 0(a0,d1.w*4),a0 ; a0 pointe apres fin de cette zone
- cmp.b #10,d3 ; type polynome ?
- bne 13$
- move.w 6(a2),d6 ; oui, longueur effective > vraie longueur
- cmp.w d1,d6
- bhi 6$ ; si oui la zone est finie.
- lea 0(a2,d6.w*4),a2
- bra.s 4$
- 13$ move.l a0,a2
- subq.l #4,a1
- 8$ addq.l #4,a1 ; passer au lgmot suivant de la zone examinee
- 4$ cmp.l a2,a1 ; a t'on fini pour cette zone
- bcc.s 6$ ; si oui zone suivante
- cmp.l (a1),d0 ; sinon le lgmot examine pointe t'il avant p ?
- bls.s 5$ ; sinon ne rien faire
- cmp.l (a1),d5 ; si oui, verifier que le long mot examine
- bhi.s 8$ ; pointe apres _avma
- add.l d2,(a1)+ ; si oui ajouter decalage
- bra.s 4$
- 5$ cmp.l (a1)+,d4 ; le longmot pointe t'il apres l ?
- bls.s 4$ ; si oui ok
- cmp.l d4,a0
- bhi.s 4$
- move.l #gerper,-(sp) ; sinon erreur
- jsr _err
- 6$ cmp.l d4,a0 ; a t'on fini ?
- bcs.s 3$ ; si a0 < d4 non : traiter zone suivante
- bne.s 7$ ; si a0 > d4 oui
- tst.l 40(sp) ; si a0 = d4 et q = 0 oui
- bne.s 3$ ; sinon traiter zone suivante :
-
- 7$ move.l d0,d1
- move.l 40(sp),d0
- beq.s 11$
- cmp.l d0,d1 ; si q pointe apres p retourner q
- bls.s 9$ ; sinon
- cmp.l d0,d5
- bhi.s 9$
- 11$ add.l d2,d0 ; retourner q + decalage ( ou decalage )
- 9$ movem.l (sp)+,d2-d6/a2-a3
- rts
-
-
- *********************************************************************
- *********************************************************************
- *** ***
- *** TYPE , MANTISSE , LONGUEUR , EXPOSANT , SIGNE . ***
- *** ***
- *** VALUATION , PRECISION DES P-ADIQUES , VARIABLES. ***
- *** ***
- *********************************************************************
- *********************************************************************
-
-
- ; entree:a7($4) pointe sur n type IouR
- ; sortie:d0.l recoit le type de n
-
- _typ moveq #0,d0
- move.b ([4,sp]),d0
- rts
-
- ; entree:a7($4) pointe sur n typeIouR
- ; a7($8) contient le long t
- ; sortie:le type de la zone pointee
- ; par a7($4) est force a t
-
- _settyp move.b 11(sp),([4,sp])
- rts
-
- ; entree:a7($4) pointe sur P type pol ou ser
- ; sortie:d0.l recoit la variable de P
-
- _varn moveq #0,d0
- move.b ([4,sp],5),d0
- rts
-
- ; entree:a7($4) pointe sur P type pol ou ser
- ; a7($8) contient le long t <= 255
- ; sortie:la variable de P est mise a t.
-
- _setvarn move.b 11(sp),([4,sp],5)
- rts
-
- ; entree:a7($4) pointe sur un type IouR
- ; a7($8) contient un long i
- ; sortie:d0.l contient le ieme longmot
- ; de la mantisse de n
-
- _mant move.l 4(sp),a0
- tst.b 4(a0)
- bne.s 1$
- moveq #0,d0
- rts
- 1$ move.w 10(sp),d0 ; indice en mantisse
- move.l 4(a0,d0.w*4),d0
- rts
-
- ; entree:a7($4) pointe sur n type IouR
- ; a7($8) contient un long i
- ; a7($12) contient un long m
- ; sortie:le i-eme long mot de mantisse
- ; de n est force a m
-
-
- _setmant move.l 4(sp),a0 ; adresse du nombre
- move.w 10(sp),d0 ; indice en mantisse
- lea 4(a0,d0.w*4),a0
- move.l 12(sp),(a0) ; met nouveau lgmot de mantisse
- rts
-
- ; entree:a7($4) pointe sur n type IouR
- ; sortie:d0.l contient longueur totale n
-
- _lg moveq #0,d0
- move.w ([4,sp],2),d0
- rts
-
- ; entree:a7($4) pointe sur n type IouR
- ; a7($8) contient un long l
- ; sortie:la longueur totale de n est
- ; forcee a l
-
- _setlg move.w 10(sp),([4,sp],2)
- rts
-
- ; entree:a7($4) pointe sur n de type I
- ; sortie:d0.l contient long.effect.de n
-
- _lgef moveq #0,d0
- move.w ([4,sp],6),d0
- rts
-
- ; entree:a7($4) pointe sur n de type I
- ; a7($8) contient un long l
- ; sortie:la longueur effective de n est
- ; forcee a l
-
- _setlgef move.w 10(sp),([4,sp],6)
- rts
-
- ; entree:a7($4) pointe sur n type IouR
- ; sortie:d0.l contient le signe de n
-
- _signe move.b ([4,sp],4),d0 ; octet numero 5 du gen
- move.b ([4,sp]),d1 ; type du gen
- cmp.b #3,d1
- bcs.s 1$
- cmp.b #4,d1
- beq.s 2$
- cmp.b #5,d1
- bne.s 1$
- 2$ move.l ([4,sp],4),a0 ; ici fraction
- move.b 4(a0),d0 ; on renvoie le sgn du num !
- 1$ extb.l d0
- rts
-
- ; entree:a7($4) pointe sur n tyxYhr+R
- ; a7($8) contient un long s
- ; sortie:le signe de n est force a s
-
- _setsigne move.b 11(sp),([4,sp],4)
- rts
-
- ; entree:a7($4) pointe sur n type IouP
- ; sortie:d0.l contient nomb. peres de n
-
- _pere moveq #0,d0
- move.b ([4,sp],1),d0
- rts
-
- ; entree:a7($4) pointe sur n type IouR
- ; a7($8) contient un long s
- ; sortie:le nomb. peres de n est s
-
- _setpere move.b 11(sp),([4,sp],1)
- rts
-
- ; augmente de 1 le nombre de peres du
- ; IouR pointe par a7($4)
-
- _incpere addq.b #1,([4,sp],1)
- bne.s 1$
- move.b #255,([4,sp],1)
- 1$ rts
-
- ; entree:a7($4) pointe sur n de type R
- ; sortie:d0.l contient le vrai exposant de n
-
- _expo move.l ([4,sp],4),d0
- and.l #$ffffff,d0
- sub.l #$800000,d0
- rts
- ; entree:a7($4) pointe sur n de type I non nul
- ; sortie:d0.l contient l'exposant de n
-
- _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
- addql #1,d1
- sub.l d1,d0
- rts
- ; entree:a7($4) pointe sur n de type R
- ; a7($8) contient le long ex
- ; sortie:l'exposant de n est force a ex
- ; ou ex est le vrai exposant(non biaise)
-
- _setexpo move.l 8(sp),d0
- add.l #$800000,d0
- move.l 4(sp),a0
- move.b 4(a0),d1
- move.l d0,4(a0)
- move.b d1,4(a0)
- rts
-
- ; entree:a7($4) pointe sur n de type p-adique
- ; ou serie.
- ; sortie:d0.l contient la valuation non biaisee
-
- _valp moveq #0,d0
- move.w ([4,sp],6),d0
- sub.l #$8000,d0
- rts
-
- ; entree:a7($4) pointe sur n de type p-adique
- ; ou serie. a7($8) contient le long valp
- ; sortie:la valuation de n est
- ; forcee a valp.
-
- _setvalp move.l 8(sp),d0
- add.l #$8000,d0
- move.w d0,([4,sp],6)
- rts
-
- ; entree:a7($4) pointe sur n de type P
- ; sortie:d0.l contient la precision de n
-
- _precp moveq #0,d0
- move.w ([4,sp],4),d0
- rts
-
- ; entree:a7($4) pointe sur n de type P
- ; a7($8) contient le long precp
- ; sortie:la precision de n est forcee
- ; a precp
-
- _setprecp move.l 8(sp),d0
- move.l 4(sp),a0
- move.w d0,4(a0)
- 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.s 1$
- ; ici T1 = I
- cmp.b #1,([4,sp])
- beq.s _affii ; ici T1 = T2 = I
- bra _affri ; ici T1 = I et T2 = R
- ; ici T1 = R
- 1$ cmp.b #1,([4,sp])
- beq _affir ; ici T1 = R et T2 = I
- bra _affrr ; ici T1 = T2 = R
-
- *-------------------------------------------------------------------*
-
- ; affectation s2 --> i1 ou r1
- _affsz cmp.b #2,([4,sp])
- beq _affsr
- ; affectation s2 --> i1
-
- _affsi link a6,#0
- movem.l d0/a0,-(sp)
- move.l 8(a6),d0 ; d0.l contient s2
- move.l 12(a6),a0 ; a0 pointe sur i1
- cmp.w #2,2(a0)
- bne.s 1$
- ; ici l1 = 2 (i1 = 0)
- tst.l d0
- beq.s 4$
- ; ici s2 <> 0 (erreur)
- move.l #affer1,-(sp)
- jsr _err
- ; ici s2 = 0 ou l1 >= 3
- 1$ tst.l d0
- 4$ bmi.s 2$
- ; ici s2 >= 0
- bne.s 3$
- ; ici s2 = 0
- move.l #2,4(a0)
- bra.s affsif
- ; ici s2 > 0 et l1 >= 3
- 3$ move.l #$1000003,4(a0)
- move.l d0,8(a0)
- bra.s affsif
- ; ici s2 < 0 et l1 >= 3
- 2$ move.l #$ff000003,4(a0)
- neg.l d0
- move.l d0,8(a0)
- affsif movem.l (sp)+,d0/a0
- unlk a6
- rts
-
- *-------------------------------------------------------------------*
-
- ; affectation i2 --> i1
-
- _affii link a6,#0
- movem.l d0/a0-a1,-(sp)
- move.l 8(a6),a1 ; a1 pointe sur i2
- move.l 12(a6),a0 ; a0 pointe sur i1
- cmp.l a0,a1
- beq.s affiif
- ; ici a0 <> a1
- move.w 2(a0),d0 ; d0.w contient l1
- cmp.w 6(a1),d0
- bcc.s 1$
- ; ici le2 > l1 (erreur)
- move.l #affer3,-(sp)
- jsr _err
- ; ici le2 <= l1
- 1$ move.w 6(a1),d0 ; d0.w contient le2
- subq.w #2,d0 ; d0.w contient L2
- addq.l #4,a0
- addq.l #4,a1
- ; copie de i2 dans i1
- 2$ move.l (a1)+,(a0)+
- dbra d0,2$
- affiif movem.l (sp)+,d0/a0-a1
- unlk a6
- rts
-
- *-------------------------------------------------------------------*
-
- ; conversion i --> long du C dans d0
-
- _itos move.l a1,-(sp)
- move.l 8(sp),a1 ; a1 pointe sur i2
- cmp.w #3,6(a1)
- bls.s 1$
- ; ici l2 >= 4 (erreur)
- move.l #affer2,-(sp)
- jsr _err
- ; ici l2 <= 3
- 1$ beq.s 2$
- ; ici l2 = 2 (i2 = 0)
- moveq #0,d0
- bra.s itosf
- ; ici l2 = 3
- 2$ move.l 8(a1),d0 ; d0.l contient |i2|
- cmp.l #$80000000,d0
- bcs.s 3$
- beq.s 4$
- ; ici |i2| > 2^31 (erreur)
- 5$ move.l #affer2,-(sp)
- jsr _err
- ; ici |i2| = 2^31
- 4$ tst.b 4(a1)
- bpl.s 5$ ; si i2 = 2^31 erreur
- bra.s itosf ; ici i2 = -2^31
- ; ici |i2| <= 2^31-1
- 3$ tst.w 4(a1)
- bpl.s itosf
- neg.l d0
- itosf move.l (sp)+,a1
- rts
-
- *-------------------------------------------------------------------*
-
- ; conversion long du C --> i cree
-
- _stoi move.l 4(sp),d1
- bne.s 1$
- move.l #2,d0
- bsr _geti
- move.l #2,4(a0)
- bra.s stoif
- 1$ move.l #3,d0
- bsr _geti
- tst.l d1
- bmi.s 2$
- move.l #$1000003,4(a0)
- bra.s 3$
- 2$ move.l #$ff000003,4(a0)
- neg.l d1
- 3$ move.l d1,8(a0)
- stoif move.l a0,d0
- rts
-
- *-----------------------------------------------------------------------*
-
- ; affectation s2 --> r1
-
- _affsr link a6,#0
- movem.l d0-d1/a0,-(sp)
- move.l 12(a6),a0 ; a0 pointe sur r1
- move.l 8(a6),d0 ; d0.l contient s2
- bne.s 1$
- ; ici s2 = 0
- moveq #0,d0
- move.w 2(a0),d0
- subq.w #2,d0
- lsl.l #5,d0
- neg.l d0
- add.l #$800000,d0 ; d0.l contient fexp(0)
- move.l d0,4(a0)
- clr.l 8(a0)
- bra.s affsrf
- ; ici s2 <> 0
- 1$ bpl.s 2$
- neg.l d0
- move.b #$ff,4(a0) ; mise signe si s2 < 0
- bra.s 3$
- 2$ move.b #1,4(a0) ; mise signe si s2 > 0
- ; ici s2 <> 0
- 3$ bfffo d0{0:32},d1 ; d1.l recoit nb. de shifts (=k)
- lsl.l d1,d0 ; d0.l est norme
- neg.w d1
- add.w #31,d1
- move.w d1,6(a0)
- move.b #$80,5(a0) ; mise exposant
- move.l d0,8(a0) ; mise 1er long mot mantisse
- moveq #0,d0
- move.w 2(a0),d1
- subq.l #3,d1 ; d1.w recoit L1-1
- add.l #12,a0 ; a0 pointe sur 2eme long mot mantisse
- bra.s 4$
- 5$ move.l d0,(a0)+
- 4$ dbra d1,5$
- affsrf movem.l (sp)+,d0-d1/a0
- unlk a6
- rts
-
- *-------------------------------------------------------------------*
-
- ; affectation i2 --> r1
-
- _affir link a6,#0
- movem.l d0-d6/a0-a1,-(sp)
- move.l 8(a6),a1 ; a1 pointe sur i2
- move.l 12(a6),a0 ; a0 pointe sur r1
- tst.b 4(a1)
- bne.s 1$
- ; ici i2 = 0
- moveq #0,d0
- move.w 2(a0),d0
- subq.w #2,d0
- lsl.l #5,d0
- neg.l d0
- add.l #$800000,d0
- move.l d0,4(a0)
- clr.l 8(a0)
- bra.s _affirf
- ; ici i2 <> 0
- 1$ move.l 8(a1),d0 ; d0.l contient 1er lg mot mantisse
- bfffo d0{0:32},d1 ; d1.l recoit nb de shifts (=k)
- lsl.l d1,d0 ; d0.l normalise
- moveq #0,d2
- move.w 6(a1),d2
- lsl.l #5,d2
- sub.l d1,d2
- add.l #$7fffbf,d2 ; d2.l = fexp2 = 2^23 + L1*32 -1 -k
- move.l d2,4(a0) ; mise exposant
- move.b 4(a1),4(a0) ; mise signe
- move.w 6(a1),d4
- subq.w #3,d4 ; d4.w recoit L2-1 (compteur)
- move.w 2(a0),d2
- subq.w #3,d2 ; d2.w recoit L1-1
- add.l #12,a1 ; a1 pointe sur 2eme lg mot mantisse i2
- addq.l #8,a0 ; a0 ponte sur 1er lg mot mantisse r1
- moveq #1,d6 ; masque
- lsl.l d1,d6
- subq.l #1,d6
- sub.w d4,d2 ; d2.w recoit L1-L2
- bpl.s 2$
- ; ici L1 < L2
- add.w d2,d4 ; d4.w recoit L1-1
- bra.s 2$
- ; copie mantisse shiftee dans r1
- 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,3$
- tst.w d2
- bmi.s 4$
- ; ici L1 > L2 completer par des 0
- moveq #0,d3
- move.l d0,(a0)+
- bra.s 5$
- 6$ move.l d3,(a0)+
- 5$ dbra d2,6$
- bra.s _affirf
- ; ici L1 <= L2
- 4$ move.l (a1)+,d3
- rol.l d1,d3
- and.l d6,d3
- add.l d3,d0
- move.l d0,(a0)+ ; mise a jour dernier lg mot
- _affirf movem.l (sp)+,d0-d6/a0-a1
- unlk a6
- rts
-
- *-------------------------------------------------------------------*
-
- ; affectation r2 --> r1
-
- _affrr link a6,#0
- movem.l d0-d1/a0-a1,-(sp)
- move.l 8(a6),a1 ; a1 pointe sur r2
- move.l 12(a6),a0 ; a0 pointe sur r1
- cmp.l a0,a1
- beq.s affrrf
- ; ici a0 <> a1
- tst.b 4(a1)
- bne.s 6$
- ; ici r2 = 0
- move.l 4(a1),4(a0)
- clr.l 8(a0)
- bra.s affrrf
- ; ici r2 <> 0
- 6$ addq.l #4,a0
- addq.l #4,a1
- move.w -2(a0),d0
- move.w -2(a1),d1 ; d0.w , d1.w contient l1,l2
- cmp.w d0,d1
- bhi.s 1$
- ; ici l1 >= l2
- sub.w d1,d0 ; d0.w contient l1-l2
- subq.w #2,d1 ; d1.w contient L2
- 3$ move.l (a1)+,(a0)+ ; copie de r2 dans r1
- dbra d1,3$
- moveq #0,d1
- bra.s 2$
- ; ici completer par des 0
- 4$ move.l d1,(a0)+
- 2$ dbra d0,4$
- bra.s affrrf
- ; ici l2 > l1
- 1$ subq.w #2,d0 ; d0.w recoit L1 (compteur)
- 5$ move.l (a1)+,(a0)+
- dbra d0,5$
- affrrf movem.l (sp)+,d0-d1/a0-a1
- unlk a6
- rts
-
- *-------------------------------------------------------------------*
-
- ; affectation r2 --> s1
-
- _affrs move.l #affer4,-(sp)
- jsr _err
-
- *-------------------------------------------------------------------*
-
- ; affectation r2 --> i1
-
- _affri move.l #affer5,-(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 ; a2 pointe sur n2
- move.l 12(a6),a1 ; a1 pointe sur n1
- move.b (a2),d2
- move.b (a1),d1 ; d1.b et d2.b contiennent T1 et T2
- cmp.b d1,d2
- beq.s 1$
- ; ici T1 <> T2 (erreur)
- move.l #exger2,-(sp)
- jsr _err
- ; ici T1 = T2
- 1$ move.l (a1),d3 ; d3.l contient le 1er lgmot code de n1
- move.l (a2),d4 ; d4.l contient le 1er lgmot code de n2
- cmp.w d3,d4
- bne.s 2$
- ; ici T1 = T2 et l1 = l2
- 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,6$
- bra.s exgf
- ; ici T1 = T2 et l1 <> l2
- 2$ cmp.b #1,d1
- bne.s 3$
- ; ici T1 = T2 = I et l1 <> l2
- cmp.w d3,d4
- ble.s 4$
- exg a1,a2 ; si l2 > l1 echanger n1 et n2
- exg d3,d4
- ; ici l2 <= l1
- 4$ cmp.w 6(a1),d4
- bpl.s 5$
- ; ici l2 < le1 (erreur)
- move.l #exger1,-(sp)
- jsr _err
- ; ici l2 >= le1
- 5$ move.l d4,d0
- bsr _geti ; allocation memoire pour copie de n2
- move.l a0,-(sp) ; empilage adresse copie
- move.l a2,-(sp) ; empilage adresse de n2
- bsr _affii
- addq.l #8,sp ; depilage
- move.l a2,-(sp) ; empilage adresse n2
- move.l a1,-(sp) ; empilage adresse n1
- bsr _affii
- addq.l #8,sp ; depilage
- move.l a1,-(sp) ; empilage adresse n1
- move.l a0,-(sp) ; empilage adresse copie
- bsr _affii
- addq.l #8,sp ; depilage
- bsr _giv ; desallouer copie
- bra.s exgf
- ; ici T1 = T2 = R et l1 <> l2
- 3$ move.l d4,d0
- bsr _getr ; allocation memoire pour copie de n2
- move.l a0,-(sp) ; empilage adresse copie
- move.l a2,-(sp) ; empilage adresse n2
- bsr _affrr
- addq.l #8,sp
- move.l a2,-(sp) ; empilage adresse n2
- move.l a1,-(sp) ; empilage adresse n1
- bsr _affrr
- addq.l #8,sp
- move.l a1,-(sp) ; empilage adresse n1
- move.l a0,-(sp) ; empilage adresse copie
- bsr _affrr
- addq.l #8,sp
- bsr _giv ; desallouer copie
- 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.s _negi
- bra _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.s 1$
- neg.b 4(a0)
- rts
- 1$ move.l 4(sp),-(sp)
- bsr.s _mpneg
- move.l d0,-(sp)
- move.l 16(sp),4(sp)
- bsr _mpaff
- move.l (sp),a0
- addq.l #8,sp
- bra _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) *
- * *
- *===================================================================*
-
- ; negation s2 --> i1
-
- _negs move.l 4(sp),d1 ; d1.l recoit s2
- bne.s 1$
- ; ici s2 = 0
- move.l _gzero,d0
- rts
- ; ici s2 <> 0
- 1$ moveq #3,d0
- bsr _geti ; allocation 3 longs mots
- move.l a0,d0 ; d0 pointe sur resultat
- move.l #$1000003,4(a0)
- neg.l d1
- bpl.s 2$
- ; ici s2 < 0
- move.b #$ff,4(a0)
- neg.l d1
- 2$ move.l d1,8(a0)
- negsf rts
-
- *-------------------------------------------------------------------*
-
- ; negation i2 --> i1
-
- _negi move.l 4(sp),a1 ; a1 pointe sur i2
- move.w 6(a1),d1
- move.l d1,d0
- bsr _geti
- move.l a0,d0 ; d0 pointe sur -i2
- addq.l #4,a0
- addq.l #4,a1
- subq.w #2,d1
- ; recopie de i2
- 1$ move.l (a1)+,(a0)+
- dbra d1,1$
- move.l d0,a0
- neg.b 4(a0)
- rts
-
- *-------------------------------------------------------------------*
-
- ; negation r2 --> r1
-
- _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,1$
- 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.s _absi
- bra _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.s 1$
- and.b #1,4(a0)
- rts
- 1$ move.l 4(sp),-(sp)
- bsr.s _mpabs
- move.l d0,-(sp)
- move.l 16(sp),4(sp)
- bsr _mpaff
- move.l (sp),a0
- addq.l #8,sp
- bra _giv
-
- *===================================================================*
- * *
- * Valeur absolue *
- * *
- * entree : a7($4) contient ou pointe sur n2 *
- * sortie : d0 pointe sur i1 ou r1 (zone creee) *
- * *
- *===================================================================*
-
- ; valeur absolue s2 --> i1
-
- _abss move.l 4(sp),d1 ; d1.l contient s2
- bne.s 1$
- ; ici s2 = 0
- move.l _gzero,d0
- rts
- ; ici s2 <> 0
- 1$ moveq #3,d0
- bsr _geti
- move.l a0,d0
- move.l #$1000003,4(a0)
- tst.l d1
- bpl.s 2$
- neg.l d1
- 2$ move.l d1,8(a0)
- rts
-
- *-------------------------------------------------------------------*
-
- ; valeur absolue i2 --> i1
-
- _absi move.l 4(sp),a1 ; a1 pointe sur i2
- move.w 6(a1),d1
- move.w d1,d0
- bsr _geti
- move.l a0,d0 ; d0 pointe sur resultat
- cmp.w #2,d1
- bne.s 1$
- ; ici i2 = 0
- move.l #2,4(a0)
- bra.s absif
- ; ici i2 <> 0
- 1$ move.l #$1000000,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,2$
- absif rts
-
- *-------------------------------------------------------------------*
-
- ; valeur absolue r2 --> r1
-
- _absr move.l 4(sp),a1
- move.w 2(a1),d1
- move.w d1,d0
- bsr _getr
- move.l a0,d0 ; a0 pointe sur resultat
- subq.w #2,d1
- addq.l #4,a1
- addq.l #4,a0
- 1$ move.l (a1)+,(a0)+
- dbra d1,1$
- move.l d0,a0
- tst.b 4(a0)
- bpl.s 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 *
- * *
- *===================================================================*
-
- ; valuation de s1 de type S
-
- _vals link a6,#0
- move.l d2,-(sp)
- moveq #-1,d0
- move.l 8(a6),d1 ; d1.l contient s1
- beq.s valsf
- moveq #0,d0
- tst.w d1
- bne.s 1$
- add.l #16,d0
- swap d1
- 1$ tst.b d1
- bne.s 2$
- addq.l #8,d0
- lsr.l #8,d1
- 2$ move.l d1,d2
- and.l #15,d2
- bne.s 3$
- addq.l #4,d0
- lsr.l #4,d1
- 3$ move.l d1,d2
- and.l #3,d2
- bne.s 4$
- addq.l #2,d0
- lsr.l #2,d1
- 4$ btst #0,d1
- bne.s valsf
- addq.l #1,d0
- valsf move.l (sp),d2
- unlk a6
- rts
-
- ; valuation de i1 de type I
-
- _vali link a6,#0
- move.l d2,-(sp)
- move.l 8(a6),a1 ; a1 pointe sur i1
- moveq #-1,d0
- tst.b 4(a1)
- beq.s valif
- ; ici i1 <> 0
- move.w 6(a1),d1 ; d1.w contient L1+2
- lea 0(a1,d1.w*4),a1 ; a1 pointe fin mantisse de i1
- move.l #$ffff,d0
- 5$ tst.l -(a1)
- dbne d0,5$
- not.w d0
- lsl.l #5,d0 ; d0.l contient 32*nb.de lgmots nuls
- move.l (a1),d1 ; a droite de i1 et a1 pointe 1er lgmot
- tst.w d1 ; non nul (qui existe car i1 <> 0)
- bne.s 1$
- add.l #16,d0
- swap d1
- 1$ tst.b d1
- bne.s 2$
- addq.l #8,d0
- lsr.l #8,d1
- 2$ move.l d1,d2
- and.l #15,d2
- bne.s 3$
- addq.l #4,d0
- lsr.l #4,d1
- 3$ move.l d1,d2
- and.l #3,d2
- bne.s 4$
- addq.l #2,d0
- lsr.l #2,d1
- 4$ btst #0,d1
- bne.s 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 _shifti
- bra _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.s 1$
- cmp.b #2,(a0)
- bne.s 1$
- move.l 4(a0),d0
- and.l #$ffffff,d0
- add.l 8(sp),d0
- bvs shier
- cmp.l #$1000000,d0
- bcc shier
- tst.l d0
- bmi 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.s _mpshift
- move.l d0,(sp)
- move.l 20(sp),4(sp)
- bsr _mpaff
- move.l (sp),a0
- addq.l #8,sp
- bra _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) ; empilage k
- move.l 8(a6),d0 ; d0.l contient s2
- bne.s 1$
- ; ici s2 = 0
- move.l #$1000002,-12(a6)
- move.l #2,-8(a6) ; creation de 0 en var. locale
- bra.s 3$
- ; ici s2 <> 0
- 1$ move.l #$1000003,-12(a6)
- move.l #$1000003,-8(a6)
- tst.l d0
- bpl.s 2$
- neg.l d0
- move.b #$ff,-8(a6)
- 2$ move.l d0,-4(a6) ; creation de s2 en var. locale
- 3$ pea -12(a6) ; empilage adresse var. locale
- bsr.s _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 ; a2 pointe sur i2
- move.l 12(a6),d7 ; d7.l contient k
- bne.s 1$
- ; ici k = 0
- move.w 2(a2),d0
- bsr _geti
- move.l a0,a3 ; sauvegarde adresse resultat
- subq.w #2,d0
- addq.l #4,a0
- addq.l #4,a2
- 24$ move.l (a2)+,(a0)+
- dbra d0,24$
- bra shiftif
- ; ici k <> 0
- 1$ tst.b 4(a2)
- bne.s 2$
- ; ici i1 = 0
- 6$ moveq #2,d0
- bsr _geti
- move.l a0,a3 ; sauvegarde adresse resultat
- move.l #2,4(a0)
- bra shiftif
- ; ici k <> 0 et i2 <> 0
- 2$ moveq #0,d0
- move.w 6(a2),d0 ; d0.w contient L2+2
- cmp.l #1,d7
- bne.s 3$
- ; ici k = 1 et i2 <> 0
- move.l 8(a2),d5
- btst #31,d5
- beq.s 4$
- ; ici d5 >= 2^31
- addq.w #1,d0 ; demander 1 lgmot supplementaire
- cmp.w #$8000,d0
- bcs.s 4$
- ; ici debordement
- 18$ move.l #shier1,-(sp)
- jsr _err
- ; ici k = 1 et i2 <> 0
- 4$ bsr _geti
- move.l a0,a3 ; sauvegarde adresse resultat
- move.w 2(a0),6(a0) ; mise longueur effective
- move.b 4(a2),4(a0) ; mise signe
- lea 0(a0,d0.w*4),a1 ; a1 pointe fin resultat
- lea 0(a2,d0.w*4),a2
- btst #31,d5
- beq.s 5$
- subq.w #4,a2 ; ici a2 pointe fin i2
- move.l #1,8(a0)
- subq.w #1,d0
- 5$ subq.w #3,d0 ; d0.w compteur
- 7$ move.l -(a2),d1
- roxl.l #1,d1
- move.l d1,-(a1)
- dbra d0,7$
- bra shiftif
- ; ici k <> 1 et i2 <> 0
- 3$ cmp.l #-1,d7
- bne.s 8$
- ; ici k = -1 et i2 <> 0
- cmp.l #1,8(a2)
- bhi.s 9$
- subq.w #1,d0
- cmp.w #2,d0
- beq 6$ ; si i1 = 0
- 9$ bsr _geti
- move.l a0,a3
- move.b 4(a2),4(a0) ; mise signe
- move.w 2(a0),6(a0) ; mise longueur effective
- addq.l #8,a0
- addq.l #8,a2
- move.w -2(a2),d0
- subq.w #3,d0 ; d0.w compteur
- move.l (a2)+,d1
- lsr.l #1,d1
- beq.s 10$
- move.l d1,(a0)+
- bra.s 10$
- 11$ move.l (a2)+,d1
- roxr.l #1,d1
- move.l d1,(a0)+
- 10$ dbra d0,11$
- bra shiftif
- ; ici k<>0,k<>1,k<>-1 et i2<>0
- 8$ tst.l d7
- bpl.s 12$
- ; ici shift a droite : k < -1 et i2 <> 0
- neg.l d7 ; d7.l contient /k/
- move.l d7,d4
- lsr.l #5,d4 ; d4.l contient r
- and.l #31,d7 ; k=32*q+r; d7.l contient q
- sub.w d4,d0 ; d0.w contient L2+2-q
- cmp.w #2,d0
- bls 2$ ; si r1 = 0
- move.l 8(a2),d4
- lsr.l d7,d4
- bne.s 13$
- ; ici on perd un lgmot de resultat
- subq.w #1,d0
- cmp.w #2,d0
- beq 6$ ; si r1 = 0
- 13$ bsr _geti ; allocation memoire pour resultat
- move.l a0,a3
- move.b 4(a2),4(a0) ; mise signe
- move.w 2(a0),6(a0) ; mise longueur effective
- lea 0(a2,d0.w*4),a2 ; a2 pointe ou il faut !
- lea 0(a0,d0.w*4),a1 ; a1 pointe fin resultat
- tst.l d4
- beq.s 14$
- move.l d4,8(a0)
- subq.w #3,d0 ; d0.w compteur
- bra.s 15$
- 14$ addq.l #4,a2
- subq.w #2,d0
- 15$ moveq #-1,d6
- lsr.l d7,d6 ; masque de shift
- move.l -(a2),d4
- lsr.l d7,d4
- bra.s 16$
- 17$ move.l -(a2),d2 ; boucle de shift
- 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
- 16$ dbra d0,17$
- bra.s shiftif
- ; ici shift a gauche : k > 1 et i2 <> 0
- 12$ move.l d7,d4
- and.l #31,d7 ; d7.l contient q
- lsr.l #5,d4 ; d4.l contient r (k=32*q+r)
- add.l d4,d0 ; d0.l contient L2+2+q
- cmp.w #$7fff,d0
- bcc 18$
- moveq #-1,d6
- lsl.l d7,d6
- not.l d6 ; masque de shift
- move.l 8(a2),d2
- rol.l d7,d2
- move.l d2,d3
- and.l d6,d3
- beq.s 19$
- addq.w #1,d0 ; un long mot supplementaire
- 19$ bsr _geti
- move.l a0,a3
- move.l 2(a0),6(a0) ; mise longueur effective
- move.b 4(a2),4(a0) ; mise signe
- addq.l #8,a0
- tst.l d3
- beq.s 20$
- move.l d3,(a0)+
- 20$ sub.l d3,d2
- move.l d2,d5
- move.w 6(a2),d0
- add.l #12,a2
- subq.w #3,d0 ; d0.w contient compteur
- bra.s 21$
- 22$ 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
- 21$ dbra d0,22$
- move.l d5,(a0)+
- moveq #0,d0
- bra.s 23$
- 25$ move.l d0,(a0)+
- 23$ dbra d4,25$
- shiftif move.l a3,d0 ; d0 pointe sur resultat
- 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 ; a2 pointe sur r2
- move.l 12(a6),d2 ; d2.l contient k
- bne.s 1$
- ; ici k = 0
- 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,4$ ; boucle de recopie de r2 dans r1
- bra.s shiftrf
- ; ici k <> 0
- 1$ move.l 4(a2),d1
- and.l #$ffffff,d1
- add.l d2,d1 ; d1.l contient fexp2 + k
- bvc.s sh
- ; ici debordement
- shier move.l #shier2,-(sp)
- jsr _err
- ; ici k + fexp2 <= 2^31 -1
- sh cmp.l #$1000000,d1
- bcc.s shier ; si k + fexp2 >= 2^24
- tst.l d1
- bmi.s shier ; si k + fexp2 < 0
- move.w 2(a2),d0
- bsr _getr ; allocation memoire pour resultat
- move.l a0,a3
- move.l d1,4(a0) ; mise exposant
- move.b 4(a2),4(a0) ; mise signe
- addq.l #8,a0
- addq.l #8,a2
- subq.w #3,d0
- 5$ move.l (a2)+,(a0)+
- dbra d0,5$
- shiftrf move.l a3,d0 ; d0 pointe sur resultat
- 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 ; a1 pointe sur n1
- cmp.b #1,(a1)
- bne.s 5$
- ; ici n1 est de type I
- 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,7$
- bra truncf
- ; ici n1 est de type R
- 5$ move.l 4(a1),d3 ; d3.l contient second long mot code r1
- move.l d3,d0
- and.l #$ffffff,d0 ; d0.l contient fexp1
- sub.l #$800000,d0 ; d0.l contient exp1
- bpl.s 1$
- ; ici exp1 < 0 (trunc r1 = 0)
- moveq #2,d0
- bsr _geti
- move.l a0,a4
- move.l #$2,4(a0)
- bra.s truncf
- ; ici exp1 >= 0
- 1$ move.l d0,d2 ; d2.l contient exp1
- lsr.l #5,d0 ; d0.l contient exp1 div 32 = q
- addq.l #3,d0 ; d0.l contient le(i1)
- cmp.l #$7fff,d0
- bls.s 2$
- ; ici le(i1)> 2^15 : erreur
- move.l #truer1,-(sp)
- jsr _err
- ; ici le(i1)<=2^15
- 2$ bsr _geti ; allocation q+3 longs mots pour i1
- move.l a0,a4
- move.w d0,6(a0) ; mise longueur effective de i1
- move.b 4(a1),4(a0) ; mise signe de i1
- move.l a0,a3 ; sauvegarde adresse i1
- addq.l #8,a0
- addq.l #8,a1 ; a0,a1 pointent sur mantisses i1,r1
- move.w -6(a1),d1 ; d1.w contient l(r1)
- sub.w d0,d1 ; d1.w contient l(r1)-le(i1)
- bpl.s 3$
- ; ici l(r1)<le(i1) : erreur
- move.l #truer2,-(sp)
- jsr _err
- ; ici l(r1)>=le(i1)
- 3$ subq.w #3,d0 ; d0.w contient l(i1)-1 (compteur)
- addq.b #1,d2 ; d2.b contient exp1+1 (derniers bits)
- and.b #31,d2 ; d2.b contient exp1+1 mod 32
- bne.s 4$
- ; ici pas de shift a faire
- 8$ move.l (a1)+,(a0)+
- dbra d0,8$ ; recopie des mantisses
- bra.s truncf
- ; ici d2.b shifts a faire
- 4$ moveq #1,d6
- lsl.l d2,d6
- subq.l #1,d6 ; masque de shift
- moveq #0,d5
- 6$ move.l (a1)+,d3 ; boucle de shift
- 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,6$
- truncf move.l a4,d0 ; d0 pointe sur resultat
- 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 _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 ; a1 pointe sur n1
- cmp.b #1,(a1)
- bne.s 1$
- ; ici n1 est de type I
- move.w 6(a1),d0 ; d0.w recoit le1
- bsr _geti
- move.l a0,a4 ; sauvegarde adresse resultat
- subq.w #2,d0
- addq.l #4,a0
- addq.l #4,a1
- 6$ move.l (a1)+,(a0)+
- dbra d0,6$
- bra entf
- ; ici n1 est de type R
- 1$ tst.b 4(a1)
- blt.s 2$
- ; ici n1 >= 0 (ent(n1)=trunc(n1))
- move.l 8(a6),-(sp) ; empilage adresse n1
- bsr _mptrunc
- move.l d0,a4 ; sauvegarde adresse resultat
- addq.l #4,sp
- bra entf
- ; ici n1 < 0
- 2$ move.l 4(a1),d3
- and.l #$ffffff,d3
- sub.l #$800000,d3 ; d3.l contient exp1
- bpl.s 3$
- ; ici exp1 < 0 (ent(n1)=-1)
- moveq #3,d0
- bsr _geti
- move.l a0,a4 ; sauvegarde adresse resultat
- move.l #$ff000003,4(a0)
- move.l #1,8(a0)
- bra.s entf
- ; ici exp1 >= 0
- 3$ move.l _avma,a3 ; ancien __avma dans var. locale
- move.l 8(a6),-(sp) ; empilage adresse n1
- bsr _mptrunc
- move.l d0,a4 ; sauvegarde adresse res. provisoire
- addq.l #4,sp ; depilage des parametres
- move.l d3,d1 ; d1.l contient exp1
- lsr.l #5,d3 ; d3.l contient exp1 div 32 = q
- and.l #31,d1 ; d1.l contient exp1 mod 32 = r
- move.l 8(a6),a1
- lea 8(a1,d3.l*4),a2 ; a2 pointe q+1eme lgmot mantisse
- move.l #$80000000,d6 ; d6.l contient 2^31
- lsr.l d1,d6 ; d6.l contient 2^(31-r)
- subq.l #1,d6 ; masque:0...01...1 avec r+1 zeros
- moveq #0,d2
- move.w 2(a1),d2
- subq.l #3,d2 ; d2.l contient L1-1
- sub.l d3,d2 ; d2.l contient L1-1-q
- move.l (a2)+,d5 ; d5.l contient le q+1 eme lgmot
- and.l d6,d5
- beq.s 4$
- bra.s 5$
- 7$ tst.l (a2)+
- 4$ dbne d2,7$
- bne.s 5$
- ; ici tous les lgmots sont nuls
- bra.s entf
- ; ici un au moins non nul
- 5$ move.l a4,-(sp) ; empilage trunc(n1)
- move.l #$ffffffff,-(sp) ; empilage -1
- bsr _addsi ; calcul de trunc(n1)-1
- addq.l #8,sp ; depilage
- move.l a4,a1 ; a1 pointe sur trunc(n1)
- move.l a3,a4 ; a4 contient __avma ancien
- move.l d0,a0 ; a0 pointe sur resultat (res)
- move.w 2(a0),d0 ; d0.w contient l(res)
- subq.w #1,d0 ; d0.w contient l-1
- 8$ move.l -(a1),-(a4)
- dbra d0,8$ ; transfert du resultat ds pile PARI
- move.l a4,_avma ; mise a jour pile PARI
- entf move.l a4,d0 ; d0 pointe sur resultat
- 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 _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 n2<n1,0 si n2=n1,1 sinon. *
- * d1,a0,a1 sont sauvegardes *
- * interdit : type S *
- * *
- *===================================================================*
-
- _mpcmp link a6,#0
- movem.l d1-d2/a1-a2,-(sp)
- move.l 8(a6),a2
- move.l 12(a6),a1 ; a1 et a2 pointent sur n1 et n2
- moveq #0,d1
- move.b (a2),d2 ; d2.b contient T2
- cmp.b (a1),d2
- ble.s 1$
- ; ici T2 > T1
- exg a1,a2
- moveq #1,d1
- ; ici T2 <= T1
- 1$ move.l a1,-(sp)
- move.l a2,-(sp)
- cmp.b #1,(a1)
- bne.s 2$
- ; ici T1 = T2 = I
- bsr _cmpii
- bra.s cmpf
- ; ici T1 = R
- 2$ cmp.b #1,(a2)
- bne.s 3$
- ; ici T1 = R et T2 = I
- bsr _cmpir
- bra.s cmpf
- ; ici T1 = T2 = R
- 3$ bsr _cmprr
- cmpf addq.l #8,sp
- tst.b d1
- beq.s 1$
- neg.l d0
- 1$ movem.l (sp)+,d1-d2/a1-a2
- unlk a6
- rts
-
- *===================================================================*
- * *
- * Comparaison : entier court et entier court *
- * *
- * entree : a7($4) contient s2 de type S *
- * a7($8) contient s1 de type S *
- * sortie : d0.l contient -1 si s2<s1,0 si s2=s1,1 sinon *
- * d1,a0,a1 sont sauvegardes *
- * *
- *===================================================================*
-
- _cmpss link a6,#0
- movem.l d1-d2,-(sp)
- move.l 8(a6),d2 ; d2.l contient s2
- move.l 12(a6),d1 ; d1.l contient s1
- cmp.l d1,d2
- beq.s 1$
- bpl.s 2$
- ; ici s2 < s1
- moveq #-1,d0
- bra.s cmpssf
- ; ici s2 > s1
- 2$ moveq #1,d0
- bra.s cmpssf
- ; ici s2 = s1
- 1$ moveq #0,d0
- cmpssf movem.l (sp)+,d1-d2
- unlk a6
- rts
-
- *===================================================================*
- * *
- * Comparaison : entier court et entier *
- * *
- * entree : a7($4) contient s2 de type S *
- * a7($8) pointe sur i1 de type I *
- * sortie : d0.l contient 1 si s2>i1,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 ; a1 pointe sur i1
- move.b 4(a1),d1 ; d1.b contient signe de i1 (si1)
- move.b d1,d4 ; d4.b contient si1
- move.b #1,d3
- move.l 8(a6),d2 ; d2.l contient s2
- bgt.s 1$ ; si s2 > 0
- ; ici s2 <= 0
- bne.s 2$ ; si s2 < 0
- ; ici s2 = 0
- move.b #0,d3
- bra.s 1$
- ; ici s2 < 0
- 2$ move.b #-1,d3 ; d3.b contient signe de s2 (ss2)
- 1$ eor.b d3,d4 ; d4.b contient :
- ; 0 si les deux nuls ou >0 ou <0
- ; >0 si un nul l'autre >0
- ; <0 si un nul autre<0,un<0 autre>0
- bpl.s 3$
- ; ici d4.b < 0
- moveq #1,d0
- tst.b d3
- bpl.s 4$
- ; ici s2<0 et i1>0
- moveq #-1,d0
- 4$ bra.s cmpsif
- ; ici d4.b >=0
- 3$ cmp.w #3,6(a1)
- ble.s 5$
- ; ici L1 >= 2
- 8$ moveq #-1,d0
- tst.b d1
- bpl.s 6$
- neg.l d0
- 6$ bra.s cmpsif
- ; ici L1 <= 1
- 5$ cmp.w #2,6(a1)
- beq.s 7$
- ; ici L1 = 1
- tst.l d2
- bpl.s 9$
- neg.l d2
- 9$ moveq #1,d0
- cmp.l 8(a1),d2
- bhi.s 10$
- bne.s 11$
- moveq #0,d0
- bra.s cmpsif
- 11$ moveq #-1,d0
- 10$ tst.b d1
- bpl.s cmpsif
- neg.l d0
- bra.s cmpsif
- 7$ moveq #1,d0
- tst.b d3
- bne.s 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 ; a1 pointe sur r1
- move.b 4(a1),d1 ; d1.b contient sr1 (signe de r1)
- move.b d1,d4 ; d4.b aussi
- move.b #1,d3
- move.l 8(a6),d2 ; d2.l contient s2
- bgt.s 1$
- bne.s 2$
- move.b #0,d3
- bra.s 1$
- 2$ move.b #-1,d3 ; d3.b contient ss2 (signe de s2)
- 1$ eor.b d3,d4 ; d4.b contient 'signe'
- bpl.s 3$
- ; ici d4.b < 0
- moveq #1,d0
- tst.b d3
- bpl.s 4$
- moveq #-1,d0
- 4$ bra.s cmpsrf
- ; ici d4.b >= 0
- 3$ tst.b d1
- bne.s 5$
- ; ici r1 = 0
- moveq #1,d0
- tst.b d3
- bne.s 6$
- ; ici s2 = r1 = 0
- moveq #0,d0
- 6$ bra.s cmpsrf
- ; ici r1 <> 0
- 5$ move.w 2(a1),d0
- bsr _getr ; pour copie reelle de s2
- move.l a0,a2 ; sauvegarde adresse copie
- move.l a0,-(sp) ; empilage adresse copie
- move.l d2,-(sp) ; empilage s2
- bsr _affsr
- addq.l #8,sp ; depilage
- move.l a1,-(sp) ; empilage adresse r1
- move.l a0,-(sp) ; empilage adresse copie
- 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 ; a1, a2 pointent sur i1, i2
- move.b 4(a1),d1 ; d1.b contient si1
- move.b d1,d4
- move.b 4(a2),d2 ; d2.b contient si2
- eor.b d2,d4
- bpl.s 1$
- ; ici d4.b < 0
- moveq #1,d0
- tst.b d2
- bpl.s cmpiif
- moveq #-1,d0
- bra.s cmpiif
- ; ici d4.b >= 0
- 1$ move.w 6(a1),d1
- move.w 6(a2),d2 ; d1.w et d2.w contiennent le1 et le2
- cmp.w d1,d2
- blt.s 3$
- beq.s 4$
- ; ici le2 > le1
- 6$ moveq #1,d0
- tst.b 4(a1)
- bpl.s cmpiif
- moveq #-1,d0
- bra.s cmpiif
- ; ici le2 < le1
- 3$ moveq #-1,d0
- tst.b 4(a2)
- bpl.s cmpiif
- moveq #1,d0
- bra.s cmpiif
- ; ici le2 = le1
- 4$ cmp.w #2,d1
- bne.s 7$
- moveq #0,d0
- bra.s cmpiif
- ; ici i1 et i2 <> 0
- 7$ move.b 4(a1),d3
- addq.l #8,a1
- addq.l #8,a2
- subq.w #3,d1
- 11$ cmpm.l (a1)+,(a2)+
- dbne d1,11$
- bhi.s 8$
- beq.s 9$
- moveq #-1,d0
- bra.s 10$
- 9$ moveq #0,d0
- bra.s cmpiif
- 8$ moveq #1,d0
- 10$ tst.b d3
- bpl.s 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 ; a1 et a2 pointent sur r1 et i2
- move.b 4(a1),d1
- move.b d1,d4
- move.b 4(a2),d2
- eor.b d2,d4
- bpl.s 1$
- moveq #1,d0
- tst.b d2
- bpl.s 2$
- moveq #-1,d0
- 2$ bra.s cmpirf
- ; ici d4.b >= 0
- 1$ tst.b d1
- bne.s 3$
- moveq #1,d0
- tst.b d2
- bne.s 4$
- moveq #0,d0
- 4$ bra.s cmpirf
- ; ici faire copie de i2 en type R
- 3$ move.w 2(a1),d0 ; allouer memoire pour copie de i2
- bsr _getr
- move.l a0,a3
- move.l a0,-(sp) ; empiler adresse copie
- move.l a2,-(sp) ; empiler adresse i2
- bsr _affir
- addq.l #8,sp ; depiler
- move.l a1,-(sp) ; empiler adresse r1
- move.l a0,-(sp) ; empiler adresse copie
- bsr.s _cmprr
- addq.l #8,sp ; depiler
- move.l a3,a0
- bsr _giv ; rendre copie
- 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.s _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 ; a1 et a2 pointent sur r1 et r2
- move.b 4(a1),d1
- move.b d1,d4
- move.b 4(a2),d2
- eor.b d2,d4
- bpl.s 1$
- ; ici d4.b < 0
- moveq #1,d0
- tst.b d2
- bpl.s 2$
- moveq #-1,d0
- 2$ bra.s cmprrf
- ; ici d4.b >= 0
- 1$ tst.b d1
- bne.s 3$
- moveq #1,d0
- tst.b d2
- bne.s 4$
- moveq #0,d0
- 4$ bra.s cmprrf
- 3$ tst.b 4(a2)
- bne.s 5$
- moveq #-1,d0
- bra.s cmprrf
- ; ici r2 <> 0
- 5$ moveq #1,d0
- move.w 2(a1),d1
- move.w 2(a2),d2
- cmp.w d1,d2
- bpl.s 6$
- exg d1,d2
- exg a1,a2
- moveq #-1,d0
- 6$ tst.b 4(a2)
- bpl.s 7$
- neg.l d0
- 7$ move.l 4(a1),d5
- and.l #$ffffff,d5
- move.l 4(a2),d3
- and.l #$ffffff,d3
- cmp.l d5,d3
- bpl.s 8$
- 10$ neg.l d0
- bra.s cmprrf
- 8$ bne.s cmprrf
- sub.w d1,d2
- subq.w #3,d1
- addq.l #8,a1
- addq.l #8,a2
- 9$ cmpm.l (a1)+,(a2)+
- dbne d1,9$
- bcs.s 10$
- beq.s 11$
- bra.s cmprrf
- 12$ tst.l (a2)+
- 11$ dbne d2,12$
- bne.s 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 ; a1 et a0 pointent sur n1 et n2
- move.b (a0),d0
- move.b (a1),d1 ; d1.b et d0.b contiennent T1 et T2
- cmp.b d1,d0
- ble.s 1$
- ; ici T2 > T1
- exg a1,a0
- exg d1,d0
- move.l a0,4(sp)
- move.l a1,8(sp)
- ; ici T2 <= T1
- 1$ cmp.b #1,d1
- beq _addii ; ici T1 = T2 = I
- 2$ cmp.b #2,d0
- beq _addrr ; ici T1 = T2 = R
- bra _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 mpopz
-
- ; addition S+S=I ou R
-
- _addssz lea _addss,a0
- bra mpopz
-
- ; addition S+I=I ou R
-
- _addsiz lea _addsi,a0
- bra mpopz
-
- ; addition S+R=R sinon erreur
-
- _addsrz lea _addsr,a0
- bra mpopz
-
- ; addition I+I=I ou R
-
- _addiiz lea _addii,a0
- bra mpopz
-
- ; addition I+R=R sinon erreur
-
- _addirz lea _addir,a0
- bra mpopz
-
- ; addition R+R=R sinon erreur
-
- _addrrz lea _addrr,a0
- bra 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 ; d1.l contient s2 + s1
- bne.s 1$
- ; ici d1.l=0
- bvs.s 2$
- ; ici s1+s2=0
- move.w #2,d0
- bsr _geti
- move.l #2,4(a0)
- bra.s addssf
- ; ici s1+s2=-2^32 (s1=s2=-2^31)
- 2$ move.w #4,d0
- bsr _geti
- move.l #$ff000004,4(a0)
- move.l #1,8(a0)
- clr.l 12(a0)
- bra.s addssf
- ; ici d1.l<>0
- 1$ move.w #3,d0
- bsr _geti
- move.l #$1000003,4(a0)
- add.l 8(a6),d2 ; repositionne les indicateurs
- bvs.s 3$
- ; ici pas d'overflow
- bmi.s 4$ ; d1 donne bien le signe du resultat
- bra.s 5$
- ; ici overflow
- 3$ bcc.s 5$ ; le carry donne le signe du resultat
- 4$ neg.l d1
- move.b #$ff,4(a0)
- 5$ move.l d1,8(a0)
- addssf move.l a0,d0 ; d0 pointe sur resultat
- 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 ; a1 pointe sur i1
- move.l 8(a6),d2 ; d2.l contient s2
- bne.s 1$ ; si s2 <> 0
- ; ici s2 = 0 (i1 + s2 = i1)
- move.w 6(a1),d0
- bsr _geti ; allocation memoire pour resultat
- move.l a0,d4
- subq.w #2,d0 ; compteur de boucle pour recopie de i1
- addq.l #4,a0
- addq.l #4,a1
- 2$ move.l (a1)+,(a0)+ ; recopie de i1
- dbra d0,2$
- bra addsif
- ; ici s2 <> 0
- 1$ tst.b 4(a1)
- bne.s 3$ ; si i1 <> 0
- ; ici i1 = 0 (i1 + s2 = s2)
- moveq #3,d0
- bsr _geti ; allocation memoire pour resultat
- move.l a0,d4
- move.l #$1000003,4(a0)
- move.l d2,8(a0)
-
- bpl addsif
- ; ici s2 < 0
- move.b #$ff,4(a0)
- neg.l 8(a0)
- bra.s addsif
- ; ici s2 et i1 <> 0
- 3$ move.w 6(a1),d0 ; d0.w contient le1
- bsr _geti
- move.l a0,d4
- move.w 4(a1),d1
- ext.l d1 ; d1.l contient signe de i1
- lea 0(a0,d0.w*4),a0
- lea 0(a1,d0.w*4),a2 ; a0 pointe fin du resultat;a2 fin de i1
- moveq #0,d3
- subq.w #3,d0 ; d0.w compteur boucle addition
- eor.l d2,d1 ; comparaison signes i1 et s2
- bmi.s susi ; si i1 * s2 < 0
- ; ici i1 * s2 > 0
- tst.l d2
- bpl.s 51$ ; valeur absolue de s2
- neg.l d2
- 51$ add.l -(a2),d2
- bra.s 4$ ; boucle d'addition
- 5$ move.l d2,-(a0)
- move.l -(a2),d2
- addx.l d3,d2
- 4$ dbra d0,5$
- bcc.s 6$ ; ici retenue finale
- move.l d2,-(a0) ; mise a jour dernier long mot
- moveq #1,d0
- bsr _geti ; allocation un long mot supplementaire
- move.l a0,d4
- move.l 4(a0),(a0)
- addq.w #1,2(a0) ; mise a jour premier long mot code
- cmp.w #$7fff,2(a0)
- bls.s 7$
- ; ici debordement
- move.l #adder1,-(sp)
- jsr _err
- 7$ move.w 2(a0),6(a0) ; mise longueur effective
- move.l #1,8(a0) ; mise a jour retenue finale
- bra.s 8$
- ; ici pas de retenue finale
- 6$ move.l d2,-(a0) ; mise a jour dernier long mot
- subq.w #8,a0
- move.w 2(a0),6(a0) ; longueur effective
- 8$ move.w 4(a1),4(a0) ; signe du resultat
- move.l a0,d4
- addsif move.l d4,d0 ; d0 pointe sur resultat
- movem.l (sp)+,d2-d4/a2
- unlk a6
- rts
- ; ici i1 * s2 < 0 : soustraction
- susi move.l d2,d1 ; d1.l recoit s2
- bpl.s 6$
- neg.l d1 ; d1.l recoit |s2|
- 6$ move.l -(a2),d2
- sub.l d1,d2 ; amorcage de la soustraction
- bra.s 1$
- ; boucle de soustraction
- 2$ move.l d2,-(a0)
- move.l -(a2),d2
- subx.l d3,d2
- 1$ dbra d0,2$
- bcc.s 3$
- ; ici retenue finale:longueur resultat=3
- neg.l d2
- move.l d2,-(a0)
- subq.l #8,a0 ; a0 pointe sur resultat
- move.w #3,6(a0) ; mise a jour longueur effective
- move.b 4(a1),d2
- neg.b d2
- move.b d2,4(a0) ; mise a jour signe (-|i1|)
- bra.s addsif
- ; ici pas de retenue finale
- 3$ tst.l d2
- beq.s 4$
- ; ici d2 <> 0
- move.l d2,-(a0)
- move.l 4(a1),-(a0) ; mise a jour second long mot code
- bra.s addsif
- ; ici d2 = 0
- 4$ move.l 4(a1),-(a0)
- subq.w #1,2(a0)
- cmp.w #2,2(a0)
- bne.s 5$
- ; ici L1 = 1 ; le resultat est 0
- clr.b (a0)
- 5$ move.l -8(a0),-(a0)
- subq.w #1,2(a0)
- move.l a0,d4
- addq.l #4,_avma ; mise a jour pile PARI
- bra.s 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 ; a2 pointe sur i2
- move.l 12(a6),a1 ; a1 pointe sur i1
- moveq #0,d2
- moveq #0,d1
- move.w 6(a2),d2
- move.w 6(a1),d1 ; d1.w recoit le1 et d2.w recoit le2
- cmp.w d1,d2
- bcc.s 1$
- exg a1,a2
- exg d1,d2 ; si L2 < L1 ,echanger a1,a2 et d1,d2
- ; ici L2 >= L1
- 1$ tst.b 4(a1)
- bne.s 2$ ; ici i1 = 0 : i1 + i2 = i2
- move.w 6(a2),d0
- bsr _geti ; allocation memoire pour recopie de i2
- subq.w #2,d0 ; compteur de recopie
- move.l a0,a1
- addq.l #4,a1
- addq.l #4,a2
- ; boucle de recopie
- 3$ move.l (a2)+,(a1)+
- dbra d0,3$
- bra addiif
- ; ici i1 <> 0 ( donc i2 <> 0)
- 2$ move.b 4(a1),d3
- move.b 4(a2),d4
- eor.b d4,d3 ; d3 contient signe de i2 * i1
- bmi suii
- ; ici i2 * i1 > 0
- move.w d2,d0
- bsr _geti ; allocation memoire le2 longs mots
- lea 0(a0,d0.w*4),a0 ; a0 pointe fin du resultat
- lea 0(a2,d0.w*4),a2 ; a2 pointe fin de i2
- lea 0(a1,d1.w*4),a1 ; a1 pointe fin de i1
- sub.w d1,d2 ; d2.w contient L2-L1
- subq.w #3,d1 ; d1.w contient L1-1 (compteur)
- moveq #0,d4
- ; ici premiere boucle d'addition
- 4$ move.l -(a1),d0
- move.l -(a2),d5
- addx.l d5,d0
- move.l d0,-(a0)
- dbra d1,4$
- roxr.w d4,d0 ; mise a jour dernier long mot
- bra.s 5$
- ; ici deuxieme boucle:propagation carry
- 6$ move.l -(a2),d0
- addx.l d4,d0
- move.l d0,-(a0)
- roxr.w d4,d0
- 5$ dbcc d2,6$
- bcs.s 7$ ; si carry jusqu'a la fin
- ; ici pas de carry
- bra.s 8$
- ; ici troisieme boucle:recopie mantisse
- 9$ move.l -(a2),-(a0)
- 8$ dbra d2,9$
- ; ici pas de carry finale
- move.l -(a2),-(a0)
- subq.l #4,a0
- bra.s addiif
- ; ici carry finale
- 7$ move.w -2(a2),d2
- addq.w #1,d2
- cmp.w #$8000,d2
- bcs.s 10$
- ; ici debordement
- move.l #adder2,-(sp)
- jsr _err
- ; ici demander 1 long mot en plus
- 10$ moveq #1,d0
- bsr _geti
- move.l #1,8(a0) ; mise retenue
- move.l 4(a0),(a0)
- move.w d2,2(a0) ; mise a jour premier long mot code
- move.l -(a2),4(a0)
- move.w d2,6(a0) ; idem deuxieme long mot code
- addiif move.l a0,d0 ; d0 pointe sur resultat
- movem.l (sp)+,d2-d7/a2-a4
- unlk a6
- rts
- ; ici i2 * i1 < 0 : soustraction
- suii move.l a1,a3
- move.l a2,a4 ; a3,a4 pointent sur i1,i2
- sub.w d1,d2 ; d2.w contient L2-L1
- bne.s 1$
- ; ici L2=L1
- subq.w #3,d1 ; d1.w contient L1-1
- addq.l #8,a3
- addq.l #8,a4 ; a3,a4 pointent debut mantisses i1,i2
- 2$ cmpm.l (a3)+,(a4)+
- dbne d1,2$ ; on compare |i1| et |i2|
- bhi.s 1$ ; si |i2| > |i1|
- ; ici |i2| < |i1|
- bne.s 3$
- ; ici |i2| = |i1| : i2 + i1 = 0
- move.w #2,d0
- bsr _geti
- move.l #2,4(a0)
- bra.s addiif
- ; ici |i2| < |i1| : echanger i2 et i1
- 3$ exg a1,a2
- ; ici |i2| > |i1| (signe i2=signe resultat)
- 1$ move.w 6(a2),d0
- bsr _geti ; allocation memoire le2 longs mots
- move.w 6(a1),d1 ; d1.w contient L1+2
- move.l a0,-(sp) ; empilage adresse resultat
- move.b 4(a2),d7 ; d7.b contient signe resultat
- lea 0(a1,d1.w*4),a1
- lea 0(a2,d0.w*4),a2
- lea 0(a0,d0.w*4),a0 ; a0,a1,a2 pointent fin resultat,i1,i2
- sub.l d3,d3 ; initialisation bit X
- subq.w #3,d1 ; d1.w contient L1-1 (compteur)
- ; premiere boucle de soustraction
- 4$ move.l -(a2),d0
- move.l -(a1),d5
- subx.l d5,d0
- move.l d0,-(a0)
- dbra d1,4$
- roxr.w d3,d0 ; restauration du bit C
- bra.s 5$
- ; deuxieme boucle:propagation carry
- 6$ move.l -(a2),d5
- subx.l d3,d5
- move.l d5,-(a0)
- roxr.w d3,d0
- 5$ dbcc d2,6$
- bra.s 7$
- ; troisieme boucle:recopie fin i2
- 8$ move.l -(a2),-(a0)
- 7$ dbra d2,8$
- move.l (sp)+,a0 ; depilage adresse resultat
- move.w 2(a0),d1 ; d1.w contient lon eff du resultat
- moveq #0,d2
- move.w d1,d2 ; d2.w idem
- addq.l #8,a0 ; a0 pointe mantisse resultat
- 9$ tst.l (a0)+
- dbne d1,9$ ; chasse aux '0' partie gauche resultat
- subq.l #4,a0 ; a0 pointe 1er long mot non nul
- move.l d1,-(a0) ; mise a jour longueur effective
- move.b d7,(a0) ; mise a jour signe
- move.w d1,-(a0) ; mise a jour longueur totale
- move.w #$101,-(a0) ; mise a jour type et peres
- sub.w d1,d2
- lsl.l #2,d2
- add.l d2,_avma ; mise a jour pile PARI
- bra 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 ; 3 lgmots pour transformer s2 en type I
- move.l 8(a6),d1 ; d1.l contient s2
- bne.s 1$
- ; ici s2 = 0
- move.l #$1000002,-12(a6)
- move.l #2,-8(a6)
- bra.s 3$
- ; ici s2 <> 0
- 1$ bmi.s 2$
- move.l #$1000003,-12(a6)
- move.l #$1000003,-8(a6)
- move.l d1,-4(a6)
- bra.s 3$
- ; ici s2 < 0
- 2$ move.l #$1000003,-12(a6)
- move.l #$ff000003,-8(a6)
- neg.l d1
- move.l d1,-4(a6)
- 3$ move.l 12(a6),-(sp)
- pea -12(a6)
- bsr.s _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 , L = L1 *
- * i2 est transforme en un reel *
- * *
- *===================================================================*
-
- _addir link a6,#-4 ; var. locale pour copie i2 en r2
- movem.l d2-d3/a2,-(sp)
- move.l 8(a6),a2
- move.l 12(a6),a1 ; a1,a2 pointent sur r1,i2
- tst.b 4(a2)
- bne.s 1$
- ; ici i2 = 0 ( i2 + r1 = r1)
- 6$ move.w 2(a1),d0
- bsr _getr
- move.l a0,-4(a6) ; sauve adresse resultat
- addq.l #4,a1
- addq.l #4,a0
- subq.w #2,d0
- ; boucle de copie d'un reel
- 4$ move.l (a1)+,(a0)+
- dbra d0,4$
- bra addirf
- ; ici i2 <> 0
- 1$ tst.b 4(a1)
- bne.s 3$
- ; ici r1 = 0 (i2 + r1 = i2)
- move.l 4(a1),d1
- sub.l #$800000,d1
- asr.l #5,d1
- moveq #0,d0
- move.w 6(a2),d0
- sub.l d1,d0 ; d0.l contient L2-[exp1/32]
- cmp.l #3,d0
- bcs 2$
- cmp.l #$8000,d0
- bcc 2$
- bsr _getr
- move.l a0,-4(a6)
- move.l a0,-(sp)
- move.l a2,-(sp)
- bsr _affir ; le resultat est i2 en type R
- addq.l #8,sp ; de longueur L2-[exp1/32]
- bra addirf
- ; ici i2 et r1 <> 0
- 3$ move.l 8(a2),d0
- bfffo d0{0:32},d1 ; d1.l recoit nb de shifts (=s)
- moveq #0,d0
- move.w 6(a2),d0
- subq.w #2,d0
- lsl.l #5,d0
- sub.l d1,d0
- subq.l #1,d0 ; d0.l recoit 32*L2-s-1 = exp2
- moveq #0,d3
- move.w 2(a1),d3 ; d3.w recoit l1
- move.l 4(a1),d2
- and.l #$ffffff,d2
- sub.l #$800000,d2 ; d2.l recoit exp1
- sub.l d0,d2 ; d2.l recoit exp1-exp2
- ble.s 5$
- ; ici exp1 > exp2
- lsr.l #5,d2 ; d2.l recoit L3=[(exp1-exp2)/32]
- sub.l d2,d3 ; d3.l recoit L1-L3+2
- cmp.l #2,d3
- ble 6$ ; si L1 <= L3 alors:r1+i2=r1
- ; ici L1 > L3
- 7$ move.l _avma,-(sp) ; empilage pile PARI
- move.w d3,d0
- bsr _getr ; allocation memoire L1-L3+2 lg mots
- ; pour ecrire i2 en type R
- move.l a0,-(sp) ; empilage r2 (copie de i2)
- move.l a2,-(sp) ; empilage i2
- bsr _affir
- move.l a1,(sp) ; empilage r1
- bsr.s _addrr
- move.l d0,a0 ; a0 pointe sur r2 + r1
- move.w 2(a0),d0 ; d0.w contient lr (longueur resultat)
- subq.w #1,d0 ; d0.w contient lr-1 (compteur pile)
- move.l 4(sp),a1 ; a1 pointe sur r2
- addq.l #8,sp ; depilage r1 et r2
- moveq #0,d1
- move.w 2(a1),d1
- lsl.l #2,d1 ; d1.l contient 4*l2 (nb d'octets a
- ; desallouer dans pile PARI)
-
- move.l (sp)+,a0 ; a0 pointe sur ancien __avma
- ; boucle de transfert du resultat
- 8$ move.l -(a1),-(a0)
- dbra d0,8$
- add.l d1,_avma ; mise a jour pile PARI
- move.l a0,-4(a6)
- bra.s addirf
- ; ici exp1 <= exp2
- 5$ neg.l d2
- lsr.l #5,d2 ; d2.l recoit L3=[(exp2-exp1)/32]
- add.w d2,d3
- addq.w #1,d3 ; d3.w recoit L1+L3+1
- cmp.w #$8000,d3
- bcs.s 7$
- ; ici debordement
- 2$ move.l #adder3,-(sp)
- jsr _err
- addirf move.l -4(a6),d0 ; d0 pointe sur resultat
- movem.l (sp)+,d2-d3/a2
- unlk a6
- rts
-
- *===================================================================*
- * *
- * Addition : 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 ( L2 , L1 + [(exp2-exp1)/32]) *
- * si exp2 >= exp1 (sinon echanger r1 et r2) *
- * *
- *===================================================================*
-
- _addrr link a6,#-16
- movem.l d2-d7/a2-a4,-(sp)
- move.l 8(a6),a2 ; a2 pointe sur r2
- move.l 12(a6),a1 ; a1 pointe sur r1
- tst.b 4(a2)
- bne 1$
- ; ici r2 = 0 (r2 + r1 = r1)
- 4$ tst.b 4(a1)
- bne.s 22$
- ; ici r2=r1=0
- move.l 4(a1),d1
- cmp.l 4(a2),d1
- bgt.s 23$
- move.l 4(a2),d1 ; d1.l contient sup(fexp1,fexp2)
- 23$ moveq #3,d0
- bsr _getr
- move.l a0,-8(a6)
- move.l d1,4(a0)
- clr.l 8(a0)
- bra addrrf
- ; ici r2 = 0 et r1 <> 0
- 22$ moveq #0,d0
- move.l 4(a2),d2 ; d2.l contient fexp2
- move.l 4(a1),d1
- and.l #$ffffff,d1 ; d1.l contient fexp1
- sub.l d2,d1 ; d1.l recoit exp1-exp2
- bcc.s 24$
- ; ici exp2 >= exp1
- moveq #3,d0
- bsr _getr
- move.l a0,-8(a6) ; le resultat est 0 avec exposant fexp2
- move.l 4(a2),4(a0)
- clr.l 8(a0)
- bra addrrf
- ; ici exp2 < exp1
- 24$ lsr.l #5,d1 ; d1.l contient [(exp1-exp2)/32]
- move.w 2(a1),d0
- subq.w #2,d0 ; d0.l contient L1
- cmp.l d1,d0
- ble.s 25$
- move.l d1,d0 ; d0.l=inf(L1,[(e1-e2)/32])=L
- addq.l #1,d0 ; le resultat est r1 en longueur:
- 25$ addq.l #2,d0 ; L1 si L1<=[(e1-e2)/32] ou
- bsr _getr
- move.l a0,-8(a6)
- addq.l #4,a1
- addq.l #4,a0
- subq.w #2,d0
- 27$ move.l (a1)+,(a0)+
- dbra d0,27$
- bra addrrf
- ; ici r2 <> 0
- 1$ tst.b 4(a1)
- bne.s 3$
- ; ici r1 = 0 (r2 + r1 = r2)
- exg a2,a1
- bra.s 22$
- ; ici r1 * r2 <> 0
- 3$ move.b 4(a1),d3
- move.b 4(a2),d5
- eor.b d5,d3 ; d3.b contient : 0 si r1 * r2 > 0
- ; et est negatif sinon
- move.b d3,-2(a6) ; sauvegarde du 'signe'
- move.l 4(a2),d3
- and.l #$ffffff,d3 ; d3.l contient fexp2=e2
- move.l 4(a1),d1
- and.l #$ffffff,d1 ; d1.l contient fexp1=e1
- sub.l d1,d3 ; d3.l contient exp2-exp1
- beq 5$ ; si e2 = e1
- bcc.s 6$ ; si e2 > e1
- ; ici e2 < e1
- exg a1,a2
- neg.l d3 ; d3.l recoit e1-e2 > 0
- ; ici e2-e1 > 0
- 6$ move.w d3,d4
- and.w #31,d4
- lsr.l #5,d3 ; e2-e1=32*L3+r ; d4.w,d3.l recoit r,L3
- moveq #0,d2
- move.w 2(a2),d2
- subq.w #2,d2 ; d2.l recoit L2
- cmp.l d2,d3
- bcs.s 7$
- ; ici L3 >= L2 (r1 + r2 = r2)
- move.w 2(a2),d0
- bsr _getr
- move.l a0,-8(a6)
- addq.l #4,a2
- addq.l #4,a0
- subq.w #2,d0
- 28$ move.l (a2)+,(a0)+
- dbra d0,28$
- bra addrrf
- ; ici L3 < L2
- 7$ moveq #0,d1
- move.w 2(a1),d1
- subq.w #2,d1 ; d1.l recoit L1
- move.l d3,d5
- add.l d1,d5 ; d5.l recoit L1 + L3
- cmp.l d2,d5
- bcs.s 8$ ; si L1 + L3 < L2
- ; ici L3 < L2 <= L1 + L3
- move.b #1,-4(a6) ; a6($-4) flag contenant :
- ; 0 si L1+L3 < L2 faire alors copie r1
- ; 1 si L3 < L2 <= L1+L3 et idem
- ; 2 si e1 = e2 et alors pas de copie
- move.w d2,d0
- addq.w #2,d0 ; d0.w recoit l2
- bsr _getr ; allocation L2+2 lgmots pour resultat
- move.l a0,-8(a6) ; adresse resultat dans var. locale
- move.w d2,d5
- sub.w d3,d5 ; d5.w contient L2 - L3
- move.w d5,d0
- addq.w #1,d0 ; d0.w contient L2 - L3 + 1
- bsr _getr ; allocation L2-L3+1 pour copie r1 avec
- ; un unique longmot code
- subq.w #2,d0 ; d0.w contient L2 - L3 - 1
- move.w 2(a2),d1
- lea 0(a2,d1.w*4),a2 ; a2 pointe fin de r2
- bra.s 9$
- ; ici L1 + L3 < L2
- 8$ clr.b -4(a6) ; a6($-4) mis a 0
- move.w d5,d0
- addq.w #3,d0 ; d0.w contient L1 + L3 + 3
- bsr _getr ; allocation pour resultat
- move.l a0,-8(a6) ; adresse resultat dans var. locale
- lea 0(a2,d0.w*4),a2 ; a2 pointe ou necessaire !!
- move.w 2(a1),d5 ; d5.w contient L1 + 2
- move.w d5,d0 ; d0.w contient L1 + 2
- subq.w #2,d5 ; d5.w contient L1
- bsr _getr ; allocation L1+2 pour copie r1 avec
- ; un seul lgmot code
- subq.w #3,d0 ; d0.w contient L1 - 1
- 9$ move.l a0,-12(a6) ; adresse copie r1 dans var. locale
- addq.l #4,a0
- move.l a0,a3 ; a0 et a3 pointent sur debut copie
- addq.l #8,a1 ; a1 pointe debut mantisse r1
- 29$ move.l (a1)+,(a0)+
- dbra d0,29$ ; boucle copie r1
- tst.w d4 ; test de r = nb de shifts
- bne.s 10$
- ; ici r = 0 ; pas de shift a faire
- ; a0 pointe fin copie r1
- ; a3 pointe debut mantisse copie r1
- moveq #0,d7
- move.w -2(a3),d7
- subq.w #1,d7 ; d7.w contient longueur mantisse copie
- move.w d7,d2
- subq.w #1,d2 ; d2.w = compteur boucle addition
- lea 0(a3,d7.w*4),a3 ; a3 pointe fin copie r1
- move.l a3,a1 ; a1 aussi
- bra.s 11$
- ; ici r <> 0 ; shift a faire
- 10$ subq.w #1,d5
- move.w d5,d2 ; d5.w et d2.w = compteur boucle shift
- move.l #-1,d6
- lsr.l d4,d6 ; masque de shift:0...01...1; avec r '0'
- moveq #0,d0
- ; boucle de shift de copie de r1
- 12$ 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,12$
- move.l a3,a1
- tst.b -4(a6)
- bne.s 11$ ; si a6($-4) <> 0
- ; ici a6($-4) = 0
- move.l d0,(a1)+
- addq.w #1,d2 ; d2.w = compteur boucle addition
- 11$ move.l -8(a6),a0 ; a0 pointe sur resultat
- moveq #0,d1
- move.w 2(a0),d1
- lea 0(a0,d1.w*4),a0 ; a0 pointe fin du resultat
- bra.s 14$
- ; ici e1 = e2
- 5$ move.b #2,-4(a6) ; a6($-4) recoit 2
- move.l d1,-16(a6) ; a6($-16) recoit e1=e2 biaise
- move.w 2(a1),d0
- cmp.w 2(a2),d0
- bcs.s 15$
- move.w 2(a2),d0
- 15$ bsr _getr ; allocation inf (l1,l2) pour resultat
- move.l a0,-8(a6) ; adresse du resultat dans var. locale
- 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 0(a0,d0.w*4),a0 ; a0 pointe fin resultat
- lea 0(a1,d0.w*4),a1 ; a1 pointe fin de r1 ou copie
- lea 0(a2,d0.w*4),a2 ; a2 pointe fin de r2
-
- ; zone des boucles d'addition
-
- ; conditions initiales :
- ; a0 pointe fin resultat
- ; a1 pointe fin r1 ou copie
- ; a2 pointe fin r2
- ; d2.w contient L4-1
- ; d3.w contient L3 avec L3+L4=long.res.
- 14$ sub.l d4,d4 ; initialisation bit X
- tst.b -2(a6) ; test du signe de r1*r2
- bne surr
- ; ici r1 * r2 > 0
- ; 1ere boucle d'addition
- 16$ move.l -(a1),d1
- move.l -(a2),d5
- addx.l d5,d1
- move.l d1,-(a0)
- dbra d2,16$
- roxr.w d4,d0 ; remise a jour du bit C
- bcc.s 17$ ; si pas de carry
- bra.s 18$ ; si carry
- ; 2eme boucle:propagation carry
- 19$ move.l -(a2),d5
- addx.l d4,d5
- move.l d5,-(a0)
- roxr.w d4,d0 ; mise a jour bit C
- 18$ dbcc d3,19$
- bcs.s 20$ ; si carry finale
- bra.s 17$
- ; 3eme boucle:recopie reste mantisse r2
- 30$ move.l -(a2),-(a0)
- 17$ dbra d3,30$
- move.l -(a2),-(a0) ; mise signe et exposant:celui de r2
- cmp.b #2,-4(a6)
- beq.s addrrf ; si a6($-4) = 2
- ; ici rendre copie de r1
- move.l -12(a6),a0
- bsr _giv
- bra.s addrrf
- ; ici carry finale
- 20$ move.l -(a2),d1
- and.l #$ffffff,d1
- addq.l #1,d1 ; d1.l recoit fexp resultat
- cmp.l #$1000000,d1
- blt.s 2$
- ; ici fexp>=2^24 : erreur
- move.l #adder4,-(sp)
- jsr _err
- ; ici non debordement
- 2$ cmp.b #2,-4(a6)
- beq.s 13$
- ; ici rendre copie de r1
- move.l a0,a3
- move.l -12(a6),a0
- bsr _giv
- move.l a3,a0
- 13$ move.l d1,-4(a0)
- move.b (a2),-4(a0) ; mise a jour exp et sign resultat
- move.w -6(a0),d2
- subq.w #3,d2 ; compteur de shift
- move.w #-1,d0
- move.w d0,ccr ; mise a 1 des bit x et c
- 31$ roxr.w (a0)+
- roxr.w (a0)+ ; boucle de mise de retenue finale et
- dbra d2,31$ ; shift de 1 vers la droite mantisse
- addrrf move.l -8(a6),d0 ; d0 pointe sur resultat
- movem.l (sp)+,d2-d7/a2-a4
- unlk a6
- rts
- ; ici faire une soustraction
- ; pour conditions initiales cf.plus haut
- 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.s 1$
- ; ici e2 = e1:comparer les mantisses
- addq.l #8,a3
- addq.l #8,a4
- 12$ cmpm.l (a3)+,(a4)+
- dbne d2,12$
- bhi.s 1$ ; si |r2| > |r1|
- bne.s 2$ ; si |r2| < |r1|
- ; ici |r2| = |r1| et donc r2 + r1 = 0
- move.l -8(a6),a0 ; le resultat est 0 avec comme exposant
- moveq #0,d2 ; -32*inf(l1,l2)+e1
- move.w 2(a0),d2
- subq.w #2,d2
- lsl.l #5,d2
- neg.l d2
- add.l -16(a6),d2 ; ajouter e1 biaise
- bpl.s 15$
- move.l #adder5,-(sp) ; underflow dans R+R
- jsr _err
- 15$ cmp.l #$1000000,d2
- blt.s 16$
- ; ici fexp>=2^24 : erreur overflow dans R+R
- move.l #adder4,-(sp)
- jsr _err
- 16$ bsr _giv
- moveq #3,d0
- bsr _getr
- move.l a0,-8(a6)
- move.l d2,4(a0)
- clr.l 8(a0)
- bra.s addrrf
- ; ici |r2| < |r1| : echanger r2 et r1
- 2$ exg a1,a2
- ; ici |r2| > |r1|
- 1$ sub.w d2,d6
- sub.l d4,d4 ; initialisation bit X
- ; 1ere boucle de soustraction
- 3$ move.l -(a2),d0
- move.l -(a1),d5
- subx.l d5,d0
- move.l d0,-(a0)
- dbra d2,3$
- roxr.w d4,d0 ; remise ajour bit C
- bra.s 4$
- ; 2eme boucle:propagation carry
- 5$ move.l -(a2),d5
- subx.l d4,d5
- move.l d5,-(a0)
- roxr.w d4,d0
- 4$ dbcc d3,5$
- bra.s 6$
- ; 3eme boucle:copie reste mantisse r2
- 13$ move.l -(a2),-(a0)
- 6$ dbra d3,13$
- moveq #0,d3
- moveq #-1,d2
- move.w d2,d3
- 14$ tst.l (a0)+
- dbne d2,14$ ; chasse aux '0' du resultat provisoire
- ; a0 pointe sur 1er lgmot non nul
- sub.w d2,d3 ; d3.w contient de lgmots nuls
- add.w d6,d3
- sub.l #12,a0 ; a0 pointe sur resultat
- move.l a0,-8(a6)
- move.l a0,a1 ; a1 aussi
- cmp.b #2,-4(a6)
- beq.s 7$ ; si pas de copie faite
- ; ici rendre copie
- move.l -12(a6),a0
- bsr _giv
- 7$ moveq #0,d0
- move.w d3,d0
- lsl.l #2,d0 ; d0.l = nb d'octets a 0 du result.
- add.l d0,_avma ; mise a jour pile PARI(rendre d3 lgmot)
- move.l a1,a0 ; a0 pointe sur resultat final
- move.w #$201,(a0)
- sub.w d3,d7
- move.w d7,2(a0) ; mise a jour 1er lgmot code resultat
- lsl.l #5,d3
- move.l 8(a0),d0
- bfffo d0{0:32},d1 ; d1.l contient nb de shifts=r
- lsl.l d1,d0 ; normalisation 1er lgmot mantisse
- add.l d1,d3
- lsl.l #2,d6
- sub.l d6,a2
- move.l -4(a2),d2
- and.l #$ffffff,d2
- sub.l d3,d2
- move.l d2,4(a0) ; calcul et mise exposant resultat
- move.b -4(a2),4(a0) ; mise signe resultat
- tst.b d1
- bne.s 8$ ; si r <> 0
- bra.s 9$ ; si r = 0
- 8$ moveq #1,d6
- lsl.l d1,d6
- subq.l #1,d6 ; masque de shift
- addq.l #8,a1
- subq.w #3,d7 ; d7.w contient L-1
- bra.s 10$
- ; boucle de shift vers la gauche
- 11$ 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
- 10$ dbra d7,11$
- move.l d0,(a1)
- 9$ bra 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.s 1$
- cmp.b #1,([4,sp])
- beq _subii
- bra _subri
- 1$ cmp.b #1,([4,sp])
- beq _subir
- bra _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 mpopz
-
- ; soustraction S-S=I ou R
-
- _subssz lea _subss,a0
- bra mpopz
-
- ; soustraction S-I=I ou R
-
- _subsiz lea _subsi,a0
- bra mpopz
-
- ; soustraction S-R=R sinon erreur
-
- _subsrz lea _subsr,a0
- bra mpopz
-
- ; soustraction I-S=I ou R
-
- _subisz lea _subis,a0
- bra mpopz
-
- ; soustraction I-I=I ou R
-
- _subiiz lea _subii,a0
- bra mpopz
-
- ; soustraction I-R=R sinon erreur
-
- _subirz lea _subir,a0
- bra mpopz
-
- ; soustraction R-S=R sinon erreur
-
- _subrsz lea _subrs,a0
- bra mpopz
-
- ; soustraction R-I=R sinon erreur
-
- _subriz lea _subri,a0
- bra mpopz
-
- ; soustraction R-R=R sinon erreur
-
- _subrrz lea _subrr,a0
- bra 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 ; d1.l recoit s1
- neg.l d1 ; d1.l recoit -s1
- bvs.s 1$
- ; ici |s1| <= 2^31-1
- move.l d1,-(sp) ; empilage -s1
- move.l 8(a6),-(sp) ; empilage s2
- bsr _addss ; calcul se s2+(-s1)
- bra.s subssf
- ; ici s1 = -2^31
- 1$ move.l #$1000003,-12(a6)
- move.l #$1000003,-8(a6)
- move.l #$80000000,-4(a6) ; creation de 2^31 type entier
- pea -12(a6) ; empilage adresse de 2^31
- move.l 8(a6),-(sp) ; empilage s2
- 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) ; empilage adresse i1
- move.l 8(a6),-(sp) ; empilage adresse i2
- move.l 12(a6),a0 ; a0 pointe sur i1
- neg.b 4(a0) ; changer signe de i1
- move.l a0,-4(a6)
- bsr _addii
- move.l -4(a6),a0
- neg.b 4(a0) ; remettre signe de i1
- 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 ; voir commentaires de _subii
- 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 ; voir commentaires de _subii
- 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 ; voir commentaires de _subii
- 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 ; voir commentaires de _subss
- move.l 8(a6),-(sp)
- move.l 12(a6),d1
- neg.l d1
- bvs.s 1$
- move.l d1,-(sp)
- bsr _addsi
- bra.s subisf
- 1$ move.l #$1000003,-12(a6)
- move.l #$1000003,-8(a6)
- move.l #$80000000,-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 ; voir commentaires de _subii
- 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 ; voir commentaires de _subii
- 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 ; voir commentaires de _subss
- move.l 8(a6),-(sp)
- move.l 12(a6),d1
- neg.l d1
- bvs.s 1$
- move.l d1,-(sp)
- bsr _addsr
- bra.s subsrf
- 1$ move.l #$1000003,-12(a6)
- move.l #$1000003,-8(a6)
- move.l #$80000000,-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 ; a1 et a0 pointent sur n1 et n2
- move.b (a0),d0
- move.b (a1),d1 ; d1.b et d0.b contiennent T1 et T2
- cmp.b d1,d0
- ble.s 1$
- ; ici T2 > T1
- exg a1,a0
- exg d1,d0
- move.l a0,4(sp)
- move.l a1,8(sp)
- ; ici T2 <= T1
- 1$ cmp.b #1,d1
- beq _mulii ; ici T1 = T2 = I
- 2$ cmp.b #2,d0
- beq _mulrr ; ici T1 = T2 = R
- bra _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 mpopz
-
- ; multiplication S*S=I ou R
-
- _mulssz lea _mulss,a0
- bra mpopz
-
- ; multiplication S*I=I ou R
-
- _mulsiz lea _mulsi,a0
- bra mpopz
-
- ; multiplication S*R=R sinon erreur
-
- _mulsrz lea _mulsr,a0
- bra mpopz
-
- ; multiplication I*I=I ou R
-
- _muliiz lea _mulii,a0
- bra mpopz
-
- ; multiplication I*R=R sinon erreur
-
- _mulirz lea _mulir,a0
- bra mpopz
-
- ; multiplication R*R=R sinon erreur
-
- _mulrrz lea _mulrr,a0
- bra 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 ; d2.l contient s2
- bne.s 1$
- 2$ move.w #2,d0 ; ici s2 ou s1 = 0
- bsr _geti
- move.l #2,4(a0)
- bra.s mulssf
- ; ici s2 <> 0
- 1$ move.l d2,d4
- bpl.s 3$
- neg.l d2 ; d2.l contient |s2|
- 3$ move.l 12(a6),d1 ; d1.l contient s1
- beq.s 2$ ; si s1=0
- eor.l d1,d4
- tst.l d1
- bpl.s 4$
- neg.l d1 ; d1.l contient |s1|
- 4$ mulu.l d1,d3:d2
- move.w #4,d0
- tst.l d3
- bne.s 5$
- move.w #3,d0 ; d0 recoit 3 ou 4 pour allocation
- 5$ bsr _geti
- move.w 2(a0),6(a0) ; met long effect.
- move.b #1,4(a0) ; met signe
- tst.l d4
- bpl.s 6$
- neg.b 4(a0)
- 6$ tst.l d3
- bne.s 7$
- move.l d2,8(a0)
- bra.s mulssf
- 7$ move.l d3,8(a0)
- move.l d2,12(a0)
- mulssf move.l a0,d0
- 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 ; d2.l contient s2
- bne.s 1$
- ; ici s2 = 0 ou i1 = 0
- 2$ move.w #2,d0
- bsr _geti
- move.l #2,4(a0)
- bra.s mulsif
- ; ici s2 <> 0
- 1$ bpl.s 6$
- neg.l d2 ; d2 contient |s2|
- 6$ move.l 12(a6),a1 ; a1 pointe sur i1
- tst.b 4(a1)
- beq.s 2$ ; si i1 = 0
- ; ici i1 <> 0 et s2 <> 0
- move.w 6(a1),d0 ; d0.w contient le1
- bsr _geti
- lea 0(a0,d0.w*4),a2 ; a2 pointe apres resultat (i0)
- lea 0(a1,d0.w*4),a1 ; a1 pointe apres i1
- subq.w #3,d0
- moveq #0,d6
- moveq #0,d5 ; initialisation retenue
- ; debut boucle multiplication
- 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,3$
- beq.s 5$
- ; ici retenue finale
- move.w #1,d0
- bsr _geti
- move.w 6(a0),d0
- addq.w #1,d0 ; d0.w contient le(i0)
- bvc.s 4$
- ; ici debordement
- move.l #muler3,-(sp)
- jsr _err
- 4$ move.w d0,2(a0) ; mise longueur
- move.l d5,8(a0) ; mise retenue
- 5$ move.w 2(a0),6(a0) ; mise le(i0)
- move.b -4(a1),4(a0)
- tst.l 8(a6)
- bpl.s mulsif
- neg.b 4(a0) ; mise signe
- mulsif move.l a0,d0
- 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 ; d2.l contient s2
- bne.s 1$
- ; ici s2 = 0
- move.l #2,d0
- bsr _geti
- move.l #2,4(a0)
- move.l a0,d0
- bra mulsrf1
- ; ici s2 <> 0
- 1$ move.l 12(a6),a1 ; a1 pointe sur r1
- tst.b 4(a1)
- bne.s 2$
- ; ici r1 = 0
- moveq #3,d0
- bsr _getr
- tst.l d2
- bpl.s 2$
- neg.l d2
- bfffo d2{0:32},d0
- move.l 4(a1),d1
- add.l #31,d1
- sub.l d0,d1
- cmp.l #$1000000,d1
- bcc 11$
- move.l d1,4(a0)
- clr.l 8(a0)
- move.l a0,d0
- bra mulsrf1
- 2$ move.w 2(a1),d0
- bsr _getr ; allocation memoire pour resultat
- move.l a0,-4(a6) ; sauvegarde adr. resultat ds var.locale
- ; ici s2 et r1 <> 0
- move.l d2,d4
- bpl.s 3$
- neg.l d2 ; d2.l contient |s2|
- 3$ cmp.l #1,d2
- bne.s 4$
- ; ici |s2| = 1
- addq.l #4,a0
- addq.l #4,a1
- subq.w #2,d0
- 5$ move.l (a1)+,(a0)+
- dbra d0,5$ ; copie de r1 dans resultat
- move.l -4(a6),a0
- tst.l d4
- bpl mulsrf
- neg.b 4(a0) ; mise signe
- bra mulsrf
- ; ici |s2| <> 1 et 0 , r1 <> 0
- 4$ move.b 4(a1),4(a0)
- tst.l d4
- bpl.s 6$
- neg.b 4(a0) ; mise signe
- 6$ lea 0(a0,d0.w*4),a0 ; a0 pointe apres resultat
- lea 0(a1,d0.w*4),a1 ; a1 pointe apres r1
- subq.w #3,d0 ; d0.w contient L1-1
- move.w d0,d4 ; d4.w idem
- move.w d4,d6
- moveq #0,d1 ; d1 a 0 pour les addx
- moveq #0,d0 ; initialisation retenue d0
- ; boucle de multiplication :
- 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 ; nouvelle retenue d0
- dbra d6,7$
- bfffo d0{0:32},d1 ; d1.l contient nb. de shifts
- lsl.l d1,d0 ; normalisation de d0
- moveq #1,d6
- lsl.l d1,d6
- subq.l #1,d6 ; masque de shift
- neg.b d1
- add.b #32,d1
- ; boucle de shift
- 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,8$
- move.l -4(a6),a0 ; a0 pointe sur resultat
- move.l -4(a1),d0
- and.l #$ffffff,d0 ; d0.l contient fexp1
- add.l d1,d0 ; d0.l contient fexp resultat
- btst #24,d0
- beq.s 9$
- ; ici debordement
- 11$ move.l #muler2,-(sp)
- jsr _err
- 9$ move.w d0,6(a0) ; mise exposant
- swap d0
- move.b d0,5(a0)
- mulsrf move.l -4(a6),d0 ; adresse du resultat
- 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 ; a1,a2 pointent sur i1,i2
- move.w 6(a1),d1
- move.w 6(a2),d2 ; d1.w, d2.w contient l1,l2
- cmp.w d1,d2
- bcc.s 1$
- ; ici l1>l2 : echanger i1 et i2
- exg a1,a2
- exg d1,d2 ; maintenant l1<=l2
- 1$ subq.w #2,d1 ; d1 recoit L1
- bne.s 2$
- ; ici L1=0 <==> i1*i2 = 0
- 6$ move.w #2,d0
- bsr _geti
- move.l #2,4(a0) ; cree resultat nul de type I
- bra muliif
- ; maintenant 1<=L1<=L2
- 2$ move.w d2,d0 ; d0 recoit l2
- add.w d1,d0 ; d0 recoit l2 + L1 = L1 + L2 + 2
- bvc.s 3$
- move.l #muler1,-(sp)
- jsr _err ; debordement
- bra.s 6$
- 3$ bsr _geti ; allocation memoire pour resultat
- move.w d0,6(a0) ; met long effect. (peutetre 1 de trop)
- move.b 4(a1),d3
- move.b 4(a2),d4
- eor.b d4,d3
- addq.b #1,d3
- move.b d3,4(a0) ; met signe du resultat
- lea 0(a0,d0.w*4),a4 ; a4 pointe apres fin resultat = z
- lea 8(a1,d1.w*4),a1 ; a1 pointe apres fin de i1 = y
- lea 0(a2,d2.w*4),a3 ; a3 pointe apres fin de i2 = x
- subq.w #1,d1 ; d1 recoit L1-1 compt bcl externe
- subq.w #3,d2 ; d2 recoit L2-1 compt bcl interne
- move.w d2,d0 ; sauvegarde compt interne dans d0
- moveq #0,d7 ; registre d7 fixe a 0
- ; Boucles de multiplication I*I :
- ; 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)
- *...................................................................*
- ; 1re boucle interne:initialise resultat
- ; (z recoit x*ym)
- move.l a3,a2 ; a2 pointe apres xn
- move.l a4,a0 ; a0 pointe apres z(n+m)
- move.l -(a1),d3 ; d3 recoit ym
- sub.l d4,d4 ; d4 registre retenue k et X initialise a 0
- m1 move.l d4,d6 ; nouvelle retenue
- move.l d3,d5 ; dupliquer multiplicateur
- mulu.l -(a2),d4:d5 ; d4:d5 recoit x1*ym
- addx.l d5,d6
- addx.l d7,d4 ; d4:d6 recoit xi*ym + k
- move.l d6,-(a0) ; range z(i+m)
- dbra d2,m1
- bra.s bclf ; brancher fin de boucle externe
- mext subq.l #4,a4 ; a4 pointe apres z(n+i)
- move.l a3,a2 ; a2 pointe apres xn
- move.l a4,a0 ; a0 pointe apres z(n+i)
- move.l d0,d2 ; d2 recoit n-1 compteur bcl interne
- move.l -(a1),d3 ; d3 recoit yj (j=m-1,m-2...1)
- sub.l d4,d4 ; d4 recoit retenue initiale k et X=0
- mint move.l d4,d6 ; sauver nouvelle retenue
- move.l d3,d5 ; dupliquer multiplicateur
- mulu.l -(a2),d4:d5 ; d4:d5 recoit xi*yj
- addx.l d5,d6
- addx.l d7,d4 ; d4:d5 recoit xi*yj + k
- add.l d6,-(a0) ; ranger partie basse de xi*yj+z(i+j)+k
- dbra d2,mint ; fin de boucle interne
- addx.l d7,d4
- bclf move.l d4,-(a0) ; range derniere retenue
- dbra d1,mext ; fin bcl externe
- *...................................................................*
- ; derniere retenue = 0 ?
- beq.s 4$
- subq.l #8,a0 ; non : rien a faire
- ; a0 pointe sur resultat
- bra.s muliif
- ; ici pas de retenue finale
- 4$ subq.w #1,-2(a0)
- subq.w #1,-6(a0) ; rectifier longueurs
- move.l -4(a0),(a0) ; deplacer mots codes
- move.l -8(a0),-(a0) ; a0 pointe sur resultat
- add.l #4,_avma
- muliif move.l a0,d0
- 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 ; variables locales pour murr aussi
- movem.l d2-d7/a2-a4,-(sp)
- move.l 8(a6),a1 ; a1 pointe sur r1
- move.l 12(a6),a2 ; a2 pointe sur r2
- move.b 4(a1),d0
- and.b 4(a2),d0
- bne.s munzr
- ; ici r1 ou r2 = 0
- muzr moveq #3,d0
- bsr _getr
- move.l a0,-8(a6)
- move.l 4(a1),d1
- and.l #$ffffff,d1 ; exposant de x1
- move.l 4(a2),d2
- and.l #$ffffff,d2 ; exposant de y
- add.l d2,d1
- sub.l #$800000,d1
- cmp.l #$1000000,d1
- bcs.s 1$
- move.l #muler4,-(sp) ; debordement r*r
- jsr _err
- 1$ tst.l d1
- bgt.s 2$
- move.l #muler5,-(sp) ; underflow r*r
- jsr _err
- 2$ move.l d1,4(a0)
- clr.l 8(a0)
- bra.s mulrrf
- munzr move.w 2(a2),d0
- clr.l -12(a6) ; Initialiser flag a 0
- cmp.w 2(a1),d0
- bls.s 1$
- move.w 2(a1),d0 ; d0.w contient L+2=inf(L1,L2)+2
- exg a1,a2 ; a2 pointe sur le + court
- bra.s 2$
- 1$ bne.s 2$
- lea 0(a1,d0.w*4),a3 ; a3 pointe sur x[L+1]
- move.l a3,-12(a6) ; longueurs egales: flag egal adresse
- move.l (a3),-16(a6) ; sauvegarde de x[L+1]
- clr.l (a3)
- 2$ bsr getr
- move.l a0,-8(a6)
- bsr.s murr ; effectuer la multiplication
- tst.l -12(a6)
- beq.s mulrrf
- move.l -12(a6),a3
- move.l -16(a6),(a3) ; remettre x[L+1]
- mulrrf move.l -8(a6),d0 ; adresse du resultat
- 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.
-
-
- murr move.l a1,a3
- lea 12(a3),a3 ; a3 pointe sur x2 (2me lgmot mant.x)
- lea 0(a2,d0.w*4),a2 ; a2 pointe apres ym
- lea 0(a0,d0.w*4),a0 ; a0 pointe apres zm
- move.l (a0),-4(a6) ; on sauvegarde le lg mot suivant z
- clr.l (a0)+ ; z(m+1) recoit 0,a0 pointe apres z(m+1)
- subq.w #3,d0 ; d0 recoit m-1
- move.l d0,-20(a6) ; sauvegarde m-1 compt. bcl externe
- clr.w d3 ; d3=0,val initiale compt bcl interne
- ; Boucles triangulaires mult. R*R
- *...................................................................*
- bext move.l a0,a4 ; a4 pointe apres z(m+1)
- move.l a3,a1 ; a1 pointe sur x(j+1) (j=1,2...m)
- move.w d3,d2 ; d3 recoit m-j compt bcl interne
- move.l -(a2),d4 ; d4 recoit yj
- move.l (a3)+,d5 ; d5 recoit x(j+1)
- sub.l d1,d1 ; d1 et X a zero
- mulu.l d4,d7:d5 ; init.retenue d7(ignorer poids faible)
- bint move.l d7,d6 ; sauver retenue
- move.l d4,d5 ; dupliquer multiplicateur
- mulu.l -(a1),d7:d5 ; d7:d5 recoit xi*yj
- addx.l d5,d6
- addx.l d1,d7 ; d7:d6 recoit xi*yj + k
- add.l d6,-(a4) ; nouveau z(i+j)
- dbra d2,bint
- addx.l d1,d7
- move.l d7,-(a4) ; range derniere retenue
- addq.w #1,d3 ; augmente de 1 long bcl interne
- dbra d0,bext ; fin bcl externe
- *...................................................................*
- move.l -4(a1),d1 ; a1 pointe sur x1 (1er mot mant de x)
- and.l #$ffffff,d1 ; exposant de x1
- move.l -4(a2),d2 ; a2 pointe sur y1
- and.l #$ffffff,d2 ; exposant de y
- add.l d2,d1
- sub.l #$800000,d1
- tst.l (a4) ; a4 pointe sur z1 : z normalise ?
- bpl.s 1$
- add.l #1,d1 ; ici mantisse normalisee
- bra.s 2$
- ; ici il faut shifter de 1 a gauche
- 1$ move.l a0,a4 ; a4 pointe apres z(m+1)
- subq.w #2,a4
- move.l -20(a6),d0 ; recuperer compteur m-1
- roxl.w -(a4) ; initialise le carry
- 5$ roxl.w -(a4) ; shift par mots (d0 compteur=m-1)
- roxl.w -(a4)
- dbra d0,5$ ; boucle de shift
- 2$ cmp.l #$1000000,d1
- bcs.s 3$
- move.l #muler4,-(sp) ; debordement r*r
- jsr _err
- 3$ tst.l d1
- bgt.s 4$
- move.l #muler5,-(sp) ; underflow r*r
- jsr _err
- 4$ move.l d1,-(a4) ; range exposant
- move.b -4(a1),d1
- move.b -4(a2),d2 ; signes
- eor.b d2,d1
- addq.b #1,d1
- move.b d1,(a4) ; range signe resultat
- move.l -4(a6),-4(a0) ; remet en place mot sous z(m+1)
- 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 ; a2 pointe sur i2
- tst.b 4(a2)
- bne.s 1$
- ; ici i2 = 0
- move.w #2,d0
- bsr _geti
- move.l #2,4(a0)
- move.l a0,d0
- bra.s mulirf1
- ; ici i2 <> 0
- 1$ move.l 12(a6),a1 ; a1 pointe sur r1
- tst.b 4(a1)
- bne.s 2$
- ; ici r1 = 0
- 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 #$1000000,d0
- bcs.s 3$
- move.l #muler6,-(sp) ; overflow I*R, R = 0
- jsr _err
- 3$ move.l d0,4(a0)
- clr.l 8(a0)
- move.l a0,d0
- bra.s mulirf1
- ; ici i2 <> 0 et r1<> 0
- 2$ move.w 2(a1),d0
- bsr _getr ; allocation memoire pour resultat
- move.l a0,-8(a6) ; sauvegarde adresse resultat
- move.w 2(a1),d0
- bsr _getr ; allocation mem pour conversion i2->r2
- move.l a0,-(a7)
- move.l a2,-(a7)
- bsr _affir
- addq.l #4,sp
- move.l (a7),a2 ; a2 recoit adr de r2=i2 (reste en pile)
- move.l -8(a6),a0 ; a0 recoit addresse du resultat
- exg a1,a2 ; Il faut que a2 soit le plus court!
- move.w 2(a2),d0 ; Mettre l'inf des longueurs dans d0 pour murr
- 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 mpopii
-
- ; division avec reste S/S=(I et I)
- ; sinon erreur
-
- _dvmdssz lea _dvmdss,a0
- bra mpopii
-
- ; division avec reste S/I=(I et I)
- ; sinon erreur
-
- _dvmdsiz lea _dvmdsi,a0
- bra mpopii
-
- ; division avec reste I/S=(I et I)
- ; sinon erreur
-
- _dvmdisz lea _dvmdis,a0
- bra mpopii
-
- ; division avec reste I/I=(I et I)
- ; sinon erreur
-
- _dvmdiiz lea _dvmdii,a0
- bra 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) ; empilage s1
- move.l 8(a6),-(sp) ; empilage s2
- bsr _divss
- dmd addq.l #8,sp
- tst.l d1
- bne.s 1$
- ; ici reste nul
- move.l d0,d1
- moveq #2,d0
- bsr _geti
- move.l #2,4(a0)
- move.l d1,d0
- bra.s dvmdssf
- ; ici reste non nul
- 1$ move.l d0,d2
- moveq #3,d0
- bsr _geti
- move.l #$1000003,4(a0)
- tst.l d1
- bpl.s 2$
- 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 ; sauvegarde adresse quotient
- tst.l d1
- bne.s 1$
- ; ici reste nul
- moveq #2,d0
- bsr _geti
- move.l #2,4(a0)
- bra.s 3$
- ; ici reste non nul
- 1$ moveq #3,d0
- bsr _geti
- move.l #$1000003,4(a0)
- tst.l d1
- bpl.s 2$
- 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.s 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 *
- * *
- * *
- * variables 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 ; a1 pointe sur le diviseur i1
- move.w 6(a1),d1 ; d1.w contient le1
- cmp.w #2,d1
- bne.s dv1
- ; ici i1 = 0
- move.l #dvmer1,-(sp)
- dvmerr jsr _err
- ; ici i1 <> 0
- dv1 move.l 8(a6),a2 ; a2 pointe sur dividende i2
- move.w 6(a2),d2 ; d2.w contient le2
- cmp.w #2,d2
- bne.s dv3
- ; ici quotient=reste=0
- dv2 move.l 16(a6),d3
- cmp.l #-1,d3
- beq.s 1$
- ; ici quotient attendu (q=0)
- moveq #2,d0
- bsr _geti
- move.l #2,4(a0)
- move.l a0,d0
- 1$ tst.l d3
- beq dvmiif
- ; ici reste attendu (r=0)
- move.l d0,d1
- moveq #2,d0
- bsr _geti
- move.l #2,4(a0)
- btst #0,d3 ; test si fonction mod
- bne.s 2$
- move.l d3,a1 ; d3 pointe sur l'adr. du reste
- move.l a0,(a1)
- move.l d1,d0
- bra dvmiif
- 2$ move.l a0,d0
- bra dvmiif
- ; ici i2 et i1 <> 0
- dv3 move.w d2,d0 ; le2
- sub.w d1,d0 ; d0.w contient L2-L1
- bcc.s dv4
- ; ici q=0 , r=i2
- move.l 16(a6),d3
- cmp.l #-1,d3
- beq.s 1$
- ; quotient attendu soit q=0
- moveq #2,d0
- bsr _geti
- move.l a0,d0
- move.l #2,4(a0)
- 1$ tst.l d3
- beq dvmiif
- ; reste attendu soit r=i1
- 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,2$
- cmp.l #-1,d3
- beq.s 3$
- move.l d3,a0
- move.l a1,(a0)
- move.l d1,d0
- bra dvmiif
- 3$ move.l a1,d0
- bra dvmiif
- ; ici L2 >= L1
- dv4 move.b 4(a1),d3 ; d3.b contient signe de i1
- move.b 4(a2),d4 ; d4.b contient signe de i2
- eor.b d4,d3
- addq.b #1,d3 ; d4.b contient signe de q
- move.b d3,-12(a6) ; sauvegarde signe de q
- move.b d4,-10(a6) ; sauvegarde signe de r
- move.l _avma,-20(a6) ; sauvegarde __avma initial
- move.w d2,d0 ; d0 recoit l2
- bsr _geti ; allocation memoire de travail :
- ; on va y former q0q1...q(n-m)r1r2...rm
- ; les memoires provisoires ne seront pas
- ; rendues par giv:on ecrase mot code
- move.l a0,-4(a6) ; sauvegarde addresse zone de travail
- subq.w #2,d1
- subq.w #2,d2
- move.w d1,-6(a6) ; sauvegarde L1 (=m)
- move.w d2,-8(a6) ; sauvegarde L2 (=n)
- move.w d2,-16(a6)
- sub.w d1,-16(a6) ; n-m dans a6($-16)
- addq.l #8,a2
- addq.l #8,a1
- move.l (a1),d3 ; d3.l=y1 (1er lgmot du diviseur i1)
- subq.w #1,d2 ; d2 recoit n-1
- subq.w #1,d1 ; d1 recoit m-1
- bne.s divlon
- ; ici division simple (m = 1)
- divsim clr.l d4
- 1$ move.l (a2)+,d5
- divu.l d3,d4:d5
- move.l d5,(a0)+
- dbra d2,1$
- move.l d4,(a0) ; reste mis derriere quotient
- move.l a0,a2 ; a2 pointe sur reste
- clr.w -14(a6) ; on n'a pas fait de shift
- bra ranger
- ; ici division longue (m > 1)
- divlon bfffo d3{0:32},d4 ; d4 recoit nb de shift pour normaliser
- move.w d4,-14(a6) ; sauvegarde du nb. de shifts = k
- bne.s 1$
- ; ici pas de normalisation
- move.l a0,a4
- move.l #0,(a4)+ ; met a 0 1er lgmot soit x0
- 4$ move.l (a2)+,(a4)+ ; recopie x1x2...xn
- dbra d2,4$
- move.l a0,a2 ; a2 pointe sur x0,a4 pointe apres xn
- lea 4(a1,d1.w*4),a3 ; a1 pointe sur y1,a3 pointe apres ym
- bra.s nosh
- ; ici on normalise le diviseur i1=y
- ; et on decale autant le dividende:
- 1$ lsl.l d4,d3 ; normalisation de y1
- move.w -6(a6),d0 ; on demande m lgmots
- bsr _geti ; allocation pour copie normalisee de y
- moveq #1,d6
- lsl.l d4,d6
- subq.l #1,d6 ; masque de shift
- move.l a0,a3
- subq.w #1,d0 ; d0 compt. mis a m-1
- addq.l #4,a1 ; a1 pointe sur y2 2me lg mot diviseur
- bra.s 3$
- 2$ move.l (a1)+,d1 ; boucle shift vers la gauche ds copie
- 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,2$
- move.l d3,(a3)+
- move.l a0,a1 ; a1 pointe sur 1er lgmot y1 normalise
- ; a3 pointe apres ym
- ; transfert avec shift du dividende:
- move.l -4(a6),a4 ; a4 pointe sur zone de travail
- moveq #0,d3
- move.w -8(a6),d0
- subq.w #1,d0 ; d0 recoit n-1 compteur
- 5$ move.l (a2)+,d1 ; boucle de shift du dividende i2
- rol.l d4,d1 ; sur place
- 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,5$
- move.l d3,(a4)
- move.l -4(a6),a2 ; a2 pointe sur x0 ;(a4 pointe sur xn)
- nosh move.w -6(a6),d6 ; d6 recoit m
- lea 4(a2,d6.w*4),a4 ; a4 pointe apres xm
- subq.w #1,d6 ; d6 recoit m-1 compteur bcls internes
- move.w -16(a6),d7 ; d7 recoit n-m compteur bcl externe
- *-------------------------------------------------------------------*
- ; boucles de division I / I :
- ; a1 pointe sur y1, a3 pointe apres ym : diviseur y1y2...ym
- ; a2 pointe sur x0, a4 pointe apres xm : dividende x0x1...xn
- ; d7 contient n-m compt. boucle externe
- ; d6 contient m compt. boucles internes (n>=m>=2)
- ; la zone x0x1...xn recoit q0q1...q(n-m)r1r2...rm
-
- bclext move.l (a1),d0 ; d0 recoit y1 (1er lgmot diviseur)
- cmp.l (a2),d0 ; xi = y1 ? (i=0,1...n)
- bne.s 1$
- moveq #-1,d1 ; oui: essayer q=2^32-1
- add.l 4(a2),d0 ; calcul du reste
- ; r=xix(i+1) mod y1 = xi+x(i+1)
- bcs.s 4$ ; si r>=2^32 , q est ok
- move.l d0,d2 ; sinon d2 recoit r
- bra.s 2$ ; rejoindre cas general
- 1$ move.l (a2),d2 ; si xi<y1 :
- move.l 4(a2),d1 ; d2:d1 recoit xix(i+1)
- divu.l d0,d2:d1 ; d1 recoit q = xix(i+1) div y1
- ; d2 recoit r = xix(i+1) mod y1
- 2$ move.l 4(a1),d3 ; d3 recoit y2
- mulu.l d1,d4:d3 ; d4:d3 recoit q*y2
- sub.l 8(a2),d3
- subx.l d2,d4 ; d4:d3 recoit q*y2-(r,x(i+2))
- bls.s 4$ ; si <= 0 alors q ok
- 3$ subq.l #1,d1 ; sinon diminuer q
- sub.l 4(a1),d3 ; corriger reste partiel:
- subx.l d0,d4 ; d3:d4 recoit d3:d4-y1y2
- bhi.s 3$ ; tant que q*y1y2>xix(i+1)x(i+2)
- ; recommencer q recoit q-1
- ; ici q*y1y2 <= xix(i+1)x(i+2)
- ; on va former le nouveau reste
- ; en remplacant x(i+1)...x(i+m) par
- ; x(i+1)...x(i+m) - q*y1...ym
- 4$ move.w d6,d0 ; d0 recoit m-1 compteur
- move.l a3,a1 ; a1 pointe apres ym
- move.l a4,a2 ; a2 pointe apres x(i+m)
- moveq #0,d2 ; d2 fixe a 0 pour les addxl
- sub.l d3,d3 ; d3 recoit k retenue initialisee a 0 et X=0
- 5$ move.l -(a1),d5 ; d5 recoit x(i+j) j=m,m-1,...,1
- mulu.l d1,d4:d5
- addx.l d3,d5
- addx.l d2,d4
- sub.l d5,-(a2) ; nouvel x(i+j)
- move.l d4,d3
- dbra d0,5$
- addx.l d2,d3
- sub.l d3,-4(a2) ; soustrait derniere retenue
- bcc.s 6$ ; si pas carry q=qi est definitif
- subq.l #1,d1 ; sinon encore 1 de trop
- move.w d6,d0 ; repositionner compteur m-1
- move.l a3,a1
- move.l a4,a2 ; repositionner pointeurs
- 7$ addx.l -(a1),-(a2)
- dbra d0,7$ ; boucle de remise a jour du reste
- ; il y a forcement carry final a ignorer
- 6$ move.l d1,-4(a2) ; qi est range sur l'ancien xi
- addq.l #4,a4 ; a4 pointe apres x(i+m+1)
- dbra d7,bclext ; boucler pour q0q1...q(n-m)
- ; fin des boucles de division I/I
- ; a2 pointe apres q(n-m),ie sur r1
- *-------------------------------------------------------------------*
- ; rangement des resultats
-
- ranger clr.l -28(a6)
- clr.l -32(a6)
- move.l _avma,-24(a6) ; actuel __avma
- move.l -20(a6),d7 ; __avma initial
- sub.l _avma,d7 ; nb d'octets memoire provisoires
- ; offset:ajouter aux addresses fournies
- move.l 16(a6),d3
- cmp.l #-1,d3
- beq.s rngres
- ; ici quotient attendu
- move.l -4(a6),a0 ; a0 pointe sur q0
- move.w -16(a6),d0 ; d0 recoit n-m
- move.w d0,d1
- addq.w #2,d0
- tst.l (a0)
- beq.s 1$
- addq.w #1,d0
- 1$ bsr _geti ; allocation memoire pour quotient
- move.l a0,-28(a6) ; a6($-28) recoit adr. provisoire de q
- add.l d7,-28(a6) ; ajoute offset memoires provisoires
- ; a6($-28) contient adr definitive de q
- lea 0(a0,d0.w*4),a1
- move.l a2,a3 ; a2 et a3 pointe sur r1
- 2$ move.l -(a3),-(a1) ; recopie q0,q1...q(n-m)
- dbra d1,2$
- move.w d0,6(a0) ; met long effective de q
- move.b -12(a6),4(a0) ; met signe de q
- cmp.w #2,d0
- bne.s rngres
- clr.b 4(a0) ; rectifier signe lorsque q=0
- rngres tst.l d3
- beq rendre
- ; ici reste attendu
- move.w -6(a6),d0
- subq.w #1,d0 ; d0 recoit m-1
- 4$ tst.l (a2)+
- dbne d0,4$ ; chasse les zeros
- bne.s 1$
- ; ici r=0 : ranger 0
- move.w #2,d0
- bsr _geti
- move.l #2,4(a0)
- add.l d7,a0 ; ajoute offset
- move.l a0,-32(a6) ; adr. definit. de r
- bra.s rendre
- 1$ subq.l #4,a2 ; a2 pointe sur 1er ri non nul
- move.w d0,d1
- addq.w #3,d0
- bsr _geti ; allocation memoire pour reste
- move.l a0,-32(a6)
- add.l d7,-32(a6) ; ajoute offset memoires provisoires
- move.b -10(a6),4(a0) ; met signe de r
- move.w d0,6(a0) ; met long effect provisoire (si shift)
- addq.l #8,a0
- move.w -14(a6),d3 ; d3 recoit k nb de shifts
- bne.s 2$
- ; ici k=0 pas de shift
- 5$ move.l (a2)+,(a0)+
- dbra d1,5$ ; recopie des ri effectifs
- bra.s rendre
- 2$ moveq #-1,d6 ; ici shift de r
- lsr.l d3,d6 ; d6 recoit masque de shift
- moveq #0,d5
- bset d3,d5 ; d5 recoit 2^k
- moveq #0,d2
- cmp.l (a2),d5 ; comparer 1er ri a 2^k
- bls.s 3$
- move.l (a2)+,d2 ; ici ri < 2^k : le shifter
- ror.l d3,d2
- subq.w #1,d0 ; et diminuer de 1 la long de la boucle
- subq.w #1,-2(a0) ; ainsi que la long effective de r
- 3$ move.l (a2)+,d5 ; boucle de shift de r
- ror.l d3,d5 ; boucle jamais vide car r>=2^k
- 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,3$
- rendre move.l -20(a6),a0 ; rendre memoires provisoires
- move.l -24(a6),a1 ; il faut rendre la zone entre a1 et a0
- move.l a1,d0
- sub.l _avma,d0
- lsr.l #2,d0 ; nb de lgmots a deplacer
- subq.w #1,d0
- 1$ move.l -(a1),-(a0)
- dbra d0,1$
- move.l a0,_avma ; nouvel __avma
- move.l -28(a6),d0
- bne.s 2$
- move.l -32(a6),d0
- bra.s dvmiif
- 2$ tst.l -32(a6)
- beq.s 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) ; reste nul ?
- beq.s 1$
- ; ici reste non nul
- moveq #0,d0
- move.l -8(a6),_avma ; desallouer q et r
- bra.s 2$
- ; ici reste nul
- 1$ move.l 16(a6),-(sp)
- move.l d0,-(sp) ; adresse du quotient
- bsr _affii
- moveq #1,d0
- move.l -8(a6),_avma ; desallouer reste
- 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) ; reste nul ?
- beq _giv
- ; ici reste non nul
- moveq #0,d0
- bra _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.s 1$
- cmp.b #1,([4,sp])
- beq _divii
- bra _divri
- 1$ cmp.b #1,([4,sp])
- beq _divir
- bra _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 ; a0,a1,a2 pointent sur n1,n2,n3
- cmp.b #1,(a2)
- bne.s 1$
- ; ici T3 = I
- cmp.b #1,(a1)
- beq.s 2$
- ; ici T3 = I et (T2 = R ou T1 = R)
- 3$ move.l #divzer1,-(sp)
- jsr _err
- ; ici T3 = I et T2 = I
- 2$ cmp.b #1,(a0)
- bne.s 3$
- ; ici T3 = T2 = T1 = I
- 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.s divzf
- ; ici T3 = R
- 1$ move.l a0,-(sp)
- cmp.b #1,(a0)
- beq.s 4$
- ; ici T3 = R et T1 = R
- move.l a1,-(sp)
- cmp.b #1,(a1)
- beq.s 5$
- ; ici T3 =T2 = T1 = R
- bsr _divrr
- bra.s 6$
- ; ici T3 = T1 = R et T2 = I
- 5$ bsr _divir
- bra.s 6$
- ; ici T3 = R et T1 = I
- 4$ cmp.b #1,(a1)
- beq.s 7$
- ; ici T3 = T2 = R et T1 = I
- move.l a1,-(sp)
- bsr _divri
- bra.s 6$
- ; ici T3 = R et T2 = T1 = I
- 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
-
- ; division S/R=R sinon erreur
-
- _divsrz lea _divsr,a0
- bra mpopz
-
- ; division R/S=R sinon erreur
-
- _divrsz lea _divrs,a0
- bra mpopz
-
- ; division I/R=R sinon erreur
-
- _divirz lea _divir,a0
- bra mpopz
-
- ; division R/I=R sinon erreur
-
- _divriz lea _divri,a0
- bra mpopz
-
- ; division R/R=R sinon erreur
-
- _divrrz lea _divrr,a0
- bra 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.s _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 _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 ; conversion dividende en R
- move.l 4(sp),(sp) ; dividende converti
- move.l 20(sp),4(sp) ; diviseur (type S)
- 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.s _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 ; conversion dividende en R
- addq.l #2,d0
- bsr _getr
- move.l a0,4(sp)
- move.l 12(a6),(sp)
- bsr _affir ; conversion diviseur en R
- 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.s 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.s _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 _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 ; conversion dividende en R
- move.l 4(sp),(sp) ; dividende converti
- move.l 20(sp),4(sp) ; diviseur (type S)
- 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.s _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 ; conversion dividende en R
- addq.l #2,d0
- bsr _getr
- move.l a0,4(sp)
- move.l 12(a6),(sp)
- bsr _affir ; conversion diviseur en R
- 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.s 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 ; d1.l recoit s1
- bne.s 1$
- ; ici s1 = 0
- move.l #diver1,-(sp)
- jsr _err
- ; ici s1 <> 0
- 1$ move.l 8(a6),d2 ; d2.l recoit s2
- bpl 9$
- moveq #-1,d3
- 9$ divs.l d1,d3:d2
- bne.s 2$
- ; ici quotient nul
- 3$ moveq #2,d0
- bsr _geti
- move.l #2,4(a0)
- move.l d3,d1
- bra.s divssf
- ; ici quotient non nul
- 2$ moveq #3,d0
- bsr _geti
- move.l #$1000003,4(a0)
- tst.l d2
- bpl.s 4$
- neg.l d2
- move.b #-1,4(a0)
- 4$ move.l d2,8(a0)
- move.l d3,d1
- divssf move.l a0,d0
- 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 ; a1 pointe sur le diviseur i1
- tst.b 4(a1)
- bne.s 1$
- ; ici i1 = 0
- move.l #diver2,-(sp)
- jsr _err
- ; ici i1 <> 0
- 1$ move.l 8(a6),d2 ; d2.l contient le dividende s2
- bne.s 3$
- ; ici quotient et reste nuls
- 2$ moveq #2,d0
- bsr _geti
- move.l #2,4(a0)
- moveq #0,d1
- bra.s divsif
- ; ici i1 et s2 <> 0
- 3$ move.w 6(a1),d1 ; d1.w contient le1
- cmp.w #3,d1
- beq.s 4$
- ; ici quotient nul et reste=s2
- 6$ moveq #2,d0
- bsr _geti
- move.l #2,4(a0)
- move.l d2,d1
- bra.s divsif
- ; ici L1 = 1
- 4$ move.l 8(a1),d1 ; d1.l contient |i1|
- move.l d2,d3 ; d3.l contient s2
- bpl.s 5$
- neg.l d3 ; d3.l contient |s2|
- 5$ moveq #0,d4
- divu.l d1,d4:d3
- beq.s 6$
- moveq #3,d0
- bsr _geti
- move.l d3,8(a0) ; ranger mantisse
- move.l 4(a1),4(a0)
- tst.l d2
- bpl.s 7$
- move.b #-1,4(a0) ; mise a jour du signe
- 7$ move.l d4,d1
- tst.b 4(a1)
- bpl.s divsif
- neg.l d1 ; mise a jour reste
- divsif move.l a0,d0
- 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 ; a1 pointe sur r1
- tst.b 4(a1)
- bne.s 2$
- ; ici r1 = 0
- move.l #diver3,-(sp)
- jsr _err
- ; ici r1 <> 0
- 2$ tst.l 8(a6)
- bne.s 1$
- ; ici s2 = 0
- move.w #2,d0
- bsr _geti
- move.l #2,4(a0)
- move.l a0,d0
- bra.s divsrf
- ; ici s2 et r1 <> 0
- 1$ moveq #0,d0
- move.w 2(a1),d0
- bsr _getr ; allocation pour resultat
- move.l 8(a6),d2 ; d2.l recoit s2
- move.l a0,a4
- addq.w #1,d0
- bsr _getr
- move.l a0,-(sp) ; sauvegarde adr. copie
- move.l d2,-(sp)
- bsr _affsr
- addq.l #4,sp
- move.l a0,a2 ; a2 pointe sur copie s2
- move.l a4,a0 ; a0 pointe sur resultat
- bsr dvrr
- move.l (sp)+,a0
- bsr _giv ; desallouer copie
- 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 ; d1 recoit s1 diviseur
- bne.s 1$
- move.l #diver4,-(sp)
- jsr _err
- 1$ bpl.s 2$
- neg.l d1
- ; ici d1 contient |s1|
- 2$ move.l 8(a6),a2 ; a2 pointe sur i2 dividende
- move.w 6(a2),d2 ; d2 recoit le2
- move.w 4(a2),d5 ; signe de i2
- bne.s 4$
- ; ici i2=0 : q=0 , r=0
- 3$ moveq #2,d0
- bsr _geti
- move.l #2,4(a0)
- moveq #0,d1 ; reste nul
- bra.s divisf
- ; ici i2 et s1 <>0
- 4$ move.w d2,d0 ; d0 recoit le2
- addq.l #8,a2
- move.l (a2)+,d4
- moveq #0,d3
- divu.l d1,d3:d4 ; calcul de q0
- bne.s 5$
- ; ici q0 = 0
- subq.w #1,d0 ; diminuer long. effective
- cmp.w #2,d0
- bne.s 5$
- ; ici q=0 , reste dans d3
- moveq #2,d0
- bsr _geti
- move.l #2,4(a0)
- bra.s 10$
- ; ici q <> 0
- 5$ bsr _geti
- move.l a0,a1
- move.w d0,6(a0) ; met long. effect.
- move.b #1,4(a0)
- move.w 12(a6),d6 ; 'signe de s1'
- eor.w d5,d6
- bpl.s 6$ ; si de meme signe
- move.b #-1,4(a0) ; si de signes contraires
- 6$ addq.l #8,a1
- tst.l d4 ; q0 = 0 ?
- beq.s 7$
- move.l d4,(a1)+ ; non: ranger q0
- 7$ subq.w #3,d2 ; d2 recoit L1 -1 compteur
- bra.s 9$
- 8$ move.l (a2)+,d4 ; boucle de division
- divu.l d1,d3:d4
- move.l d4,(a1)+
- 9$ dbra d2,8$
- 10$ move.l d3,d1 ; le reste est mis dans d1
- tst.w d5 ; i1 > 0 ?
- bpl.s divisf
- neg.l d1 ; non : changer signe de r
- divisf move.l a0,d0 ; met addresse resultat
- 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) ; empilage de i1
- move.l 12(sp),-(sp) ; empilage de i2
- bsr _dvmdii
- lea 12(sp),sp ; depilage
- 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 ; var. locales pour appel dvrr
- movem.l a2-a3,-(sp)
- move.l 12(a6),a1 ; a1 pointe sur r1
- tst.b 4(a1)
- bne.s 1$
- ; ici r1 = 0
- move.l #diver5,-(sp)
- jsr _err
- ; ici r1 <> 0
- 1$ move.l 8(a6),a2 ; a2 pointe sur i2
- tst.b 4(a2)
- bne.s 2$
- ; ici i2 = 0
- move.w #2,d0
- bsr _geti
- move.l #2,4(a0)
- move.l a0,d0
- bra.s divirf
- 2$ moveq #0,d0 ; ici i2 et r1 <> 0
- move.w 2(a1),d0 ; d0.w contient l1
- bsr _getr ; allocation pour resultat
- move.l a0,a3
- addq.w #1,d0
- bsr _getr ; allocation pour conversion i2 type R
- move.l a0,-16(a6) ; sauvegarde adr. du transforme i2'
- move.l a0,-(sp)
- move.l a2,-(sp)
- bsr _affir
- addq.l #8,sp
- move.l a0,a2 ; a2 pointe sur i2'
- move.l a3,a0 ; a0 pointe sur resultat
- bsr dvrr
- move.l -16(a6),a0
- bsr _giv ; desallouer i2'
- 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 ; d1 recoit s1 diviseur
- bne.s 1$
- ; ici s1 = 0
- move.l #diver6,-(sp)
- jsr _err
- ; ici diviseur s1 <> 0
- 1$ move.l 8(a6),a2 ; a2 pointe sur r2 dividende
- tst.b 4(a2)
- bne.s 2$
- ; ici r2 = 0
- moveq #3,d0
- bsr _getr
- tst.l d1
- bpl.s 11$
- neg.l d1
- 11$ bfffo d1{0:32},d0
- add.l 4(a2),d0
- sub.l #31,d0
- bmi 9$
- move.l d0,4(a0)
- clr.l 8(a0)
- bra divrsf
- ; ici r2 et s1 <> 0
- 2$ move.w 2(a2),d0 ; d0 recoit l2
- bsr _getr ; allocation pour resultat
- move.b 4(a2),4(a0) ; signe de r2
- tst.l d1
- bpl.s 3$
- neg.l d1 ; d1 recoit |s1| <= 2^31
- ; s1 est tjrs <= 1er mot mantisse
- ; le 1er quotient partiel est non nul
- neg.b 4(a0)
- 3$ move.l a0,a1
- addq.l #8,a1
- addq.l #8,a2
- subq.w #3,d0 ; d0 recoit L2-1 compteur
- move.l d0,d2 ; conserve dans d2
- moveq #0,d3 ; 1er reste
- 4$ move.l (a2)+,d4
- divu.l d1,d3:d4
- move.l d4,(a1)+
- dbra d0,4$ ; boucle de division
-
- move.l 8(a0),d0 ; resultat normalise ?
- bpl.s 10$
- moveq #0,d1 ; ici normalise ; nb shift = 0
- bra.s 5$
- ; ici il faut normaliser
-
- 10$ moveq #0,d4
- divu.l d1,d3:d4 ; traite dernier reste: quotient
- ; a recuperer par le shift
- bfffo d0{0:32},d1 ; nb de shift dans d1
- lsl.l d1,d0 ; shift 1er lg mot d0
- move.l a0,a1
- addq.l #8,a1
- moveq #1,d6
- lsl.l d1,d6
- subq.l #1,d6 ; d6 masque de shift
- bra.s 7$
- 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,6$
- rol.l d1,d4 ; shifter dernier quotient
- and.l d6,d4
- add.l d4,d0
- move.l d0,(a1)
- 5$ move.l 8(a6),a2 ; a2 pointe sur r2 dividende
- move.l 4(a2),d2
- and.l #$ffffff,d2 ; exposant biaise de r2
- sub.l d1,d2 ; exposant resultat
- bpl.s 8$
- ; ici underflow
- 9$ move.l #diver7,-(sp)
- jsr _err
- 8$ move.w d2,6(a0)
- swap d2
- move.b d2,5(a0) ; range exposant
- 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 ; var. locales pour appel dvrr
- movem.l d2-d3/a2-a3,-(sp)
- move.l 12(a6),a1 ; a1 pointe sur le diviseur i1
- tst.b 4(a1)
- bne.s 1$
- ; ici i1 = 0
- move.l #diver8,-(sp)
- jsr _err
- ; ici i1 <> 0
- 1$ move.l 8(a6),a2 ; a2 pointe sur le dividende r2
- tst.b 4(a2)
- bne.s 2$
- ; ici r2 = 0
- 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.s 3$
- move.l #diver12,-(sp) ; underflow R/I avec R = 0
- jsr _err
- 3$ move.l d1,4(a0)
- clr.l 8(a0)
- move.l a0,d0
- bra.s divrif
- ; ici r2 et i1 <> 0
- 2$ moveq #0,d0
- move.w 2(a2),d0
- bsr _getr ; allocation pour resultat
- move.l _avma,a3 ; eviter le chevauchement
- subq.l #8,a3
- move.l a3,_avma
- move.l #2,(a3) ; hack pour que giv rende ceci
- move.l a0,a3 ; sauvegarde adr. resultat
- addq.w #1,d0
- bsr _getr ; allocation pour conversion i1 type R
- move.l a0,-16(a6) ; sauvegarde adr. copie
- move.l a0,-(sp)
- move.l a1,-(sp)
- bsr _affir
- addq.l #8,sp
- move.l a0,a1 ; a1 pointe sur copie i1
- move.l a3,a0 ; a0 pointe sur resultat
- bsr dvrr
- move.l -16(a6),a0
- bsr _giv ; desallouer copie
- 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 ; var. locales pour appel dvrr
- move.l a2,-(sp)
- move.l 12(a6),a1 ; a1 pointe sur r1=y diviseur
- move.l 8(a6),a2 ; a2 pointe sur r2=x dividende
- tst.b 4(a1) ; r1 = 0 ?
- bne.s 1$
- ; ici r1 = 0
- move.l #diver9,-(sp)
- jsr _err
- 1$ tst.b 4(a2) ; r2 = 0 ?
- bne.s 3$
- ; ici r2=0, r1<>0 : resultat nul
- moveq #3,d0
- bsr _getr
- move.l 4(a1),d0
- and.l #$ffffff,d0 ; exposant de r1
- sub.l 4(a2),d0
- neg.l d0
- add.l #$800000,d0
- cmp.l #$1000000,d0
- bcs.s 4$
- move.l #diver11,-(sp) ; debordement r/r
- jsr _err
- 4$ tst.l d0
- bgt.s 5$
- move.l #diver10,-(sp) ; underflow r/r
- jsr _err
- 5$ move.l d0,4(a0)
- clr.l 8(a0)
- bra.s divrrf
- 3$ move.w 2(a1),d0
- cmp.w 2(a2),d0
- bls.s 2$
- move.w 2(a2),d0 ; d0 recoit l=inf(l1,l2)
- 2$ bsr _getr
- bsr.s dvrr ; effectuer la division !
- 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 variables 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 ; signe de r1
- move.b 4(a2),d2 ; signe de r2
- eor.b d2,d1
- addq.b #1,d1
- move.b d1,-2(a6) ; sauvegarde signe resultat
- move.l 4(a2),d2
- and.l #$ffffff,d2
- move.l 4(a1),d1
- and.l #$ffffff,d1
- sub.l d1,d2 ; exposant provisoire sans offset
- add.l #$800000,d0 ; ajouter offset
- move.l d2,-6(a6) ; sauvegarde
- move.w 2(a0),d0 ; d0.w recoit longueur resultat ( inf(l1,l2) )
- move.w 2(a1),d1
- cmp.w #3,d1
- bne.s 5$
- move.l 8(a1),d1
- move.l 8(a2),d3
- clr.l d2
- cmp.w #3,2(a2)
- beq.s 7$
- move.l 12(a2),d2
- 7$ cmp.l d3,d1
- bls.s 6$
- divu.l d1,d3:d2
- move.l d2,8(a0)
- move.l -6(a6),d0
- subq.l #1,d0
- bra 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 comd2
- 5$ sub.w d0,d1 ; flag nombre de mots du diviseur
- move.w d1,-28(a6) ; a sauvegarder.
- subq.w #2,d0
- move.w d0,d7 ; d0 et d7 recoit m=inf(l1,l2)-2
- move.w d7,-12(a6) ; d7 sera compt boucle externe
- move.l (a0),-10(a6) ; sauvegarde 1er lg mot code resultat
- ; (on a besoin de toute la place)
- move.w 2(a2),d6
- subq.w #2,d6
- addq.l #8,a2 ; a2 pointe sur y1 (1er mot dividende
- ; on note y=y1y2...ym le dividende
- move.l a0,a4
- clr.l (a4)+
- 1$ move.l (a2)+,(a4)+ ; on recopie m+1 lgmots mantisse de y
- dbra d0,1$ ; precede par un zero
- ; y(m+1) peut ne pas exister
- ; c'est alors n'importe quoi !
- cmp.w d7,d6 ; l2>l1 ?
- bgt.s 4$
- clr.l -4(a4) ; Si l2<=l1, y(m+1) n'existe pas
- ; a4 pointe apres y(m+1)
- 4$ move.l a0,a2 ; a2 pointe sur y0=0 1er mot dividende
- addq.l #8,a1 ; a1 pointe sur x1 1er mot diviseur
- lea 8(a1,d7.w*4),a3 ; a3 pointe apres x(m+2)
- move.l a3,-32(a6)
- move.w -28(a6),d6 ; (peut etre n'importe quoi mais va etre
- bne.s 2$ ; corrige)
- move.l -8(a3),-20(a6)
- clr.l -8(a3)
- 2$ subq.w #1,d6
- bgt.s 3$
- move.l -4(a3),-24(a6)
- clr.l -4(a3)
- 3$ moveq #0,d6 ; d6 recoit 0 pour les addx
-
- ; Boucles de division R/R
- ; d7 compt bcl externe initialise a m
- ; pour trouver q0q1...qm
- ; d0 compt bcl interne initialise
- ; par d7 a chaque tour
- *...................................................................*
- dext move.l (a1),d0 ; d0 recoit x1 (1er mot diviseur)
- cmp.l (a2),d0 ; compare a yi
- bne.s 1$
- move.l #-1,d1 ; essayer q=2^32-1
- add.l 4(a2),d0
- bcs.s 4$
- move.l d0,d2
- bra.s 2$
- 1$ move.l (a2),d2 ; d2 recoit yi
- move.l 4(a2),d1 ; d2:d1 recoit yiy(i+1)
- divu.l d0,d2:d1 ; d1 recoit q = yiy(i+1) div x1
- ; d2 recoit r = yiy(i+1) mod x1
- 2$ move.l 4(a1),d3 ; d3 recoit x2
- mulu.l d1,d4:d3 ; d4:d3 recoit q*x2
- sub.l 8(a2),d3
- subx.l d2,d4 ; d4:d3 recoit q*x2-(r,y(i+2))
- bls.s 4$
-
- 3$ subq.l #1,d1 ; ici q est trop grand : q-1
- sub.l 4(a1),d3
- subx.l d0,d4 ; correction du reste partiel
- bhi.s 3$ ; boucler tant que trop
- ; ici q =yiy(i+1)y(i+2) div x1x2 correct
- ; on va calculer le reste partiel
- 4$ move.w d7,d0 ; d0 recoit m-i compteur
- move.l a3,a1 ; a3,a1 pointent apres y(m+2-i)
- move.l a4,a2 ; a4,a2 pointent apres y(m+1)
- move.l -(a1),d2
- mulu.l d1,d3:d2 ; initialise retenue d3 par
- sub.l d2,d2 ; poids fort de q*y(m+2-i). d2=X=0
- 5$ move.l -(a1),d5
- mulu.l d1,d4:d5 ; boucle interne de multiplication et
- addx.l d3,d5 ; soustraction :
- addx.l d2,d4 ; yi...y(m+1) recoit yi...y(m+1)-
- sub.l d5,-(a2) ; q*x1...x(m+1-i)
- move.l d4,d3
- dbra d0,5$
- addx.l d2,d3
- sub.l d3,-4(a2)
- bcc.s 6$
- ; ici carry: q encore 1 de trop
- subq.l #1,d1
- move.w d7,d0
- move.l a3,a1
- move.l a4,a2
- subq.l #4,a1 ; correction sur a1 (car on avait prevu
- ; d'initialiser la retenue)
- 7$ addx.l -(a1),-(a2)
- dbra d0,7$ ; boucle de readdition(met reste a jour)
- 6$ move.l d1,-4(a2) ; qi correct ! ranger a la place de xi
- subq.l #4,a3 ; a3 p. un mot de moins pour bcle suiv.
- ; a3 pointe sur x(m-i+1)
- bcdf dbra d7,dext ; fin de boucle externe de division
- *...................................................................*
- move.l -32(a6),a3
- move.w -28(a6),d5 ; remise eventuelle de xm+1 et xm+2
- bne.s 7$
- move.l -20(a6),-8(a3)
- 7$ subq.w #1,d5
- bgt.s 8$
- move.l -24(a6),-4(a3)
- 8$ move.w -12(a6),d5
- move.w d5,d4 ; d4 recoit m
- 6$ move.l -(a2),4(a2)
- dbra d5,6$
- move.l -10(a6),(a2)+ ; 1er lg mot code;a2 pointe sur q1
- move.l -6(a6),d0 ; exposant non biaise
- move.l (a2),d1 ; d1 recoit q0=0 ou 1
- bne.s 1$
- ; ici q0=0 : mantisse correcte
- subq.l #1,d0 ; retrancher 1 a l'exposant
- bra.s comd2
- 1$ addq.l #4,a2 ; ici q0=1 : shifter de 1 a droite
- subq.w #1,d4 ; d4 recoit m-1
- asr.w #1,d1 ; met carry flag
- 5$ roxr.w (a2)+
- roxr.w (a2)+
- dbra d4,5$ ; boucle de normalisation
- comd2 cmp.l #$1000000,d0
- ble.s 3$
- move.l #diver10,-(sp) ; underflow
- jsr _err
- 3$ bcs.s 4$
- move.l #diver11,-(sp) ; overflow
- jsr _err
- 4$ move.l d0,4(a0) ; range exposant
- move.b -2(a6),4(a0) ; range signe
- movem.l (sp)+,d2-d7/a2-a5
- 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.s _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 mpopi
-
- ; modulo S mod S = I sinon erreur
-
- _modssz lea _modss,a0
- bra mpopi
-
- ; modulo S mod I = I sinon erreur
-
- _modsiz lea _modsi,a0
- bra mpopi
-
- ; modulo I mod S = I sinon erreur
-
- _modisz lea _modis,a0
- bra mpopi
-
- ; modulo I mod I = I sinon erreur
-
- _modiiz lea _modii,a0
- bra 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 ; d1.l contient s1
- bne.s 1$
- ; ici s1 = 0
- move.l #moder1,-(sp)
- jsr _err
- ; ici s1 <> 0
- 1$ move.l 8(a6),d2 ; d2.l contient s2
- bpl 9$
- moveq #-1,d3
- 9$ divs.l d1,d3:d2
- tst.l d3
- bne.s 2$
- ; ici reste nul
- 3$ moveq #2,d0
- bsr _geti
- move.l #2,4(a0)
- bra.s 7$
- ; ici reste non nul
- 2$ bmi.s 5$
- ; ici reste > 0
- moveq #3,d0
- bsr _geti
- move.l #$1000003,4(a0)
- move.l d3,8(a0)
- bra.s 7$
- ; ici reste < 0
- 5$ move.l 12(a6),-(sp)
- move.l d3,-(sp)
- tst.l d1
- bpl.s 6$
- ; ici s1 < 0
- bsr _subss
- addq.l #8,sp
- bra.s modssf
- ; ici s1 > 0
- 6$ bsr _addss
- addq.l #8,sp
- bra.s 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 ; desallouer memoire provisoire
- tst.l d1 ; tester le reste
- bne.s 1$
- ; ici reste nul
- moveq #2,d0
- bsr _geti
- move.l #2,4(a0)
- bra.s 2$
- ; ici reste non nul
- 1$ bmi.s 3$
- ; ici reste > 0
- move.l d1,d3 ; d3.l recoit le reste
- moveq #3,d0
- bsr _geti
- move.l #$1000003,4(a0)
- move.l d3,8(a0)
- bra.s 2$
- ; ici reste < 0
- 3$ move.l 12(a6),-(sp)
- move.l d1,-(sp)
- move.l 12(a6),a1 ; a1 pointe sur i1
- tst.b 4(a1)
- bpl.s 5$
- ; ici i1 < 0
- bsr _subsi
- bra.s 6$
- ; ici i1 > 0
- 5$ bsr _addsi
- 6$ addq.l #8,sp
- bra.s 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.s 1$
- ; ici reste nul
- moveq #2,d0
- bsr _geti
- move.l #2,4(a0)
- bra.s 2$
- ; ici reste non nul
- 1$ bmi.s 3$
- ; ici reste > 0
- move.l d1,d3
- moveq #3,d0
- bsr _geti
- move.l #$1000003,4(a0)
- move.l d3,8(a0)
- bra.s 2$
- ; ici reste < 0
- 3$ move.l 12(a6),-(sp)
- move.l d1,-(sp)
- move.l 12(a6),d1 ; d1.l contient s1
- bpl.s 5$
- bsr _subss
- bra.s 6$
- 5$ bsr _addss
- 6$ addq.l #8,sp
- bra.s 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) ; empilage adresse i1
- move.l 8(a6),-(sp) ; empilage adresse i2
- move.l _avma,-4(a6) ; sauvegarde adr. tete pile PARI
- bsr _dvmdii
- move.l d0,a1 ; a1 pointe sur resultat
- tst.b 4(a1)
- bpl.s modiif
- ; ici reste negatif
- move.l a1,(sp) ; empilage adr. du reste
- tst.b ([12,a6],4) ; test signe du modulo
- bpl.s 1$
- bsr _subii
- bra.s 2$
- 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 ; a0 pointe sur pile initiale
- 3$ move.l -(a1),-(a0)
- dbra d0,3$ ; ecraser resultat intermediaire
- move.l a0,_avma
- move.l a0,d0 ; nouvelle adresse resultat
- 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 mpopi
-
- ; reste de S/S = I sinon erreur
-
- _resssz lea _resss,a0
- bra mpopi
-
- ; reste de S/I = I sinon erreur
-
- _ressiz lea _ressi,a0
- bra mpopi
-
- ; reste de I/S = I sinon erreur
-
- _resisz lea _resis,a0
- bra mpopi
-
- ; reste de I/I = I sinon erreur
-
- _resiiz lea _resii,a0
- bra 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 ; d1.l contient le diviseur s1
- bne.s 1$
- ; ici s1 = 0
- move.l #reser1,-(sp)
- jsr _err
- ; ici s1 <> 0
- 1$ move.l 8(a6),d2 ; d2.l contient s2
- bpl 9$
- moveq #-1,d3
- 9$ divs.l d1,d3:d2
- tst.l d3
- bne.s 2$
- ; ici reste nul
- moveq #2,d0
- bsr _geti
- move.l #2,4(a0)
- bra.s resssf
- ; ici reste non nul
- 2$ moveq #3,d0
- bsr _geti
- move.l #$1000003,4(a0)
- tst.l d3
- bpl.s 3$
- neg.l d3
- move.b #-1,4(a0)
- 3$ move.l d3,8(a0)
- resssf move.l a0,d0
- 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) ; empilage adr. i1
- move.l 8(sp),-(sp) ; empilage s2
- bsr _divsi
- move.l d0,a0 ; a0 pointe sur resultat prov.
- bsr _giv
- tst.l d1 ; d1.l contient le reste
- bne.s 1$
- ; ici reste nul
- moveq #2,d0
- bsr _geti
- move.l #2,4(a0)
- bra.s ressif
- ; ici reste non nul
- 1$ moveq #3,d0
- bsr _geti
- move.l #$1000003,4(a0)
- tst.l d1
- bpl.s 2$
- neg.l d1
- move.b #-1,4(a0)
- 2$ move.l d1,8(a0)
- ressif move.l a0,d0
- 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) ; empilage s1
- move.l 8(sp),-(sp) ; empilage adr.i2
- bsr _divis
- move.l d0,a0
- bsr _giv ; desallouer memoire provisoire
- tst.l d1 ; le reste est dans d1.l
- bne.s 1$
- ; ici reste nul
- moveq #2,d0
- bsr _geti
- move.l #2,4(a0)
- bra.s resisf
- ; ici reste non nul
- 1$ moveq #3,d0
- bsr _geti
- move.l #$1000003,4(a0)
- tst.l d1
- bpl.s 2$
- neg.l d1
- move.b #-1,4(a0)
- 2$ move.l d1,8(a0)
- resisf move.l a0,d0
- 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 *
- * *
- *===================================================================*
-
- ; operation a trois operandes
- ; les trois operandes sont de type I
-
- mpariz move.b ([12,sp]),d0
- add.b ([8,sp]),d0
- add.b ([4,sp]),d0
- cmp.b #3,d0
- beq.s mpopz
- move.l #arier1,-(sp)
- jsr _err
-
- ; le troisieme operande est de type I
-
- mpopi cmp.b #1,([12,sp])
- beq.s mpopz
- move.l #arier2,-(sp)
- jsr _err
- ; operation quelconque
-
- mpopz move.l 8(sp),-(sp) ; 2eme operande
- move.l 8(sp),-(sp) ; 1er operande
- jsr (a0)
- move.l 20(sp),4(sp) ; 3eme operande
- move.l d0,(sp) ; resultat operation
- jsr _mpaff
- addq.l #8,sp
- move.l d0,a0
- bra _giv
-
- ; operation a quatre operandes
- ; avec deux resultats de type I
-
- mpopii move.b ([16,sp]),d0
- add.b ([12,sp]),d0
- cmp.b #2,d0
- beq.s mpopz2
- move.l #arier2,-(sp)
- jsr _err
-
- ; operation a quatre operande
-
- mpopz2 link a6,#-8
- move.l _avma,-8(a6)
- pea -4(a6)
- move.l 12(a6),-(sp) ; 2eme operande
- move.l 8(a6),-(sp) ; 1er operande
- jsr (a0)
- addq.l #4,sp
- move.l -4(a6),(sp)
- move.l 20(a6),4(sp)
- bsr _mpaff ; rangement 2 eme resultat
- move.l d0,(sp)
- move.l 16(a6),4(sp)
- bsr _mpaff ; rangement 1 er resultat
- 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 _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 _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 _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.s 1$
- clr.l (a2)+ ; ici entier nul
- bra.s 2$
- 1$ bsr.s _divisii
- move.l d1,(a2)+
- tst.b 4(a3)
- bne.s 1$
- 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 #$ffffff,d1
- sub.l #$800000,d1
- not.l d1
- move.l d1,d7 ; d1 et d7 recoivent -e-1
- subq.l #2,d0 ; d0 recoit L
- lsl.l #5,d0
- add.l d1,d0
- move.l d0,d2 ; d0 et d2 recoivent 32*L-e-1
- add.l #95,d0 ; 95=3*32-1
- lsr.l #5,d0
- bsr _geti ; alloc. pour mantisse denormalisee
- move.l d0,-4(a6)
- lsr.l #5,d7 ; d7 recoit -e-1 div 32
- move.l a0,a2
- bra.s 1$
- 2$ clr.l (a0)+
- 1$ dbra d7,2$
- move.w 2(a1),d3
- subq.l #3,d3 ; d3 recoit L-1 compteur
- addq.l #8,a1
- and.l #31,d1 ; d1 recoit -e-1 mod 32 = nb de shifts
- bne.s 3$
- ; ici pas de shift
- 4$ move.l (a1)+,(a0)+
- dbra d3,4$
- bra.s 5$
- 3$ moveq #-1,d6
- lsr.l d1,d6 ; masque de shift
- 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,6$
- move.l d4,(a0)+
- 5$ clr.l (a0)
- mulu.l #8651,d3:d2
- divu.l #28738,d3:d2 ; on mult par Log(2)/Log(10)=0.30103
- move.l d2,d0
- addq.l #1,d0
- move.l d0,d7 ; d0,d7 <-- ndecfrac=nb de decimales
- add.l #17,d0 ; 17=2*9-1
- divu #9,d0
- bsr _geti ; alloc memoire pour resultats
- move.l a0,-12(a6) ; adresse resultats
- move.l d7,(a0)+ ; ndecfrac est passe au prog C
- subq.w #2,d0 ; d0 recoit compteur nb de mult.
- move.l -4(a6),d1 ; longueur mantisse denormalisee
- lea 0(a2,d1.w*4),a2
- subq.l #1,d1
- move.l a2,a3 ; a2 et a3 pointent apres mant.denorm.
- 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,1$
- move.l d2,(a0)+
- move.l a3,a2 ; adr apres fin mantisse denorm.
- move.l d3,d1
- dbra d0,boext
- move.l -12(a6),d0 ; d0 pointe sur le resultat
- movem.l (sp)+,d2-d7/a2-a3
- move.l -8(a6),_avma
- unlk a6
- rts
-
-
-
-
-
- *===================================================================*
- * *
- * Reservations memoire pour systeme PARI *
- * *
- *===================================================================*
-
-
- even
- * .lcomm _bot,4 ; pile PARI
- * .lcomm _top,4 ; tete pile PARI
- * .lcomm __avma,4 ; memoire contenant adr. sommet pile PARI
- END
-