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