;; Copyright (1986) JM Alliot pour la version Lattice/Metacomco ;; Copyright (1990) JM Alliot pour la version Aztec cseg entry _compte public _compte mille equ 1000 nbp equ 6 macro copy2 move.w d5,(a0,d1) ;tmp->tab[j] move.w d5,(a2,d4) ;stocke le nombre intermediaire dans la zone temp cmp.w #mille,d5 ;si le nb<1000, il faut sauvegarder la sol bcc ss\@ tas.b (a1,d5) bne ss\@ ;La sol a deja ete sauvegarde lsl.w #4,d5 ;On multiplie par 8*2 pour adresse zone sol move.w #(nbp*2),d6 ;On recopie zone temp dans zone sol add.w d6,d5 toto\@ subq.w #2,d6 subq.w #2,d5 move.w (a2,d6),(a3,d5) cmp.w d4,d6 bne toto\@ ;On s'arrete a nb ss\@ cmpi.w #2,d4 beq %1 ;si nb vaut 2 (1*2) on arrete la recursion movem.w d0-d3,-(a7) ;on recurse bsr b1 movem.w (a7)+,d0-d3 endm ;;En entree: tableau des nombres dans 4(a7) ;;Retourne l'adresse du tableau contenant les sols ;;La solution pour le nombre n se trouve de n*8+5 a n*8 ;;Elle ne contient que les nombres intermediaires ;;Il faut reconstruire les plaques par la suite ;;d0=i d1=j d2=tabi d3=tabj d4=nb d5=tmp d6=tmp2 _compte move.l 4(a7),a0 ; Recuperer l'adresse de l'argument movem.l d4-d7/a2-a5,-(a7) ;A sauvegarder pour le compilo Aztec lea tz,a1 ; Mise a zero par precaution move.w #(lres-tz),d0 rep move.b #0,(a1,d0) subq.w #1,d0 bne rep lea lres,a2 lea res,a3 move.l #(2*nbp),d4 bsr b1 move.l a3,d0 movem.l (a7)+,d4-d7/a2-a5 rts b1 subq.w #2,d4 move.w #0,d0 ;i=0 b2 move.w (a0,d0),d2 ;tab[i]->tabi move.w (a0,d4),(a0,d0) ;tab[nb]->tab[i] move.w d0,d1 ;j=i b3 move.w (a0,d1),d3 ;tab[j]->tabj move.w d3,d5 ;tabj->tmp add.w d2,d5 ;tabi+tmp->tmp bcs ssub ;carry->depassement->pas d'add/pas de mult copy2 smul smul cmpi.w #1,d2 beq ssub cmpi.w #1,d3 beq ssub ;tabi=1 ou tabj=1 ->pas de div, pas de mul move.w d3,d5 ;tabj->tmp mulu d2,d5 ;tabi*tmp->tmp move.l d5,d6 ;tmp->tmp2 and.l #$ffff0000,d6 ;tmp2&0xFFFF0000->tmp2 bne sdiv ;la partie haute de d6 est <>0 ->depassement copy2 sdiv sdiv cmp.w d2,d3 bcc div2 ;d3>d2 move.w d2,d5 ;tabi->tmp divu d3,d5 ;tmp/tabj->tmp bra div3 div2 move.w d3,d5 ;tabj->tmp divu d2,d5 ;tmp/tabi->tmp div3 move.l d5,d6 ;tmp->tmp2 and.l #$ffff0000,d6 ;tmp2&0xFFFF0000->tmp2 bne ssub ;la partie haute de d6 est <>0 ->reste<>0 cmp.w d3,d5 beq ssub cmp.w d2,d5 beq ssub ;si a/b=b on elimine copy2 ssub ssub cmp.w d2,d3 beq fin ;si tabi=tabj pas de soustraction bcc sub2 ;d3-d2 move.w d2,d5 ;tabi->tmp sub.w d3,d5 ;tmp-tabi->tmp cmp.w d3,d5 beq fin ;si a-b=b on elimine bra sub3 sub2 move.w d3,d5 ;tabj->tmp sub.w d2,d5 ;tmp-tabi->tmp cmp.w d2,d5 beq fin ;si a-b=b on elimine sub3 copy2 fin fin move.w d3,(a0,d1) ;tabj->tab[j] addq.w #2,d1 cmp.w d4,d1 bne b3 move.w d2,(a0,d0) ;tabi->tab[i] addq.w #2,d0 cmp.w d4,d0 bne b2 addq.w #2,d4 rts dseg tz dcb.b mille,0 res dcb.w mille*8,0 lres dcb.w 8,0 end