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