LEX    'XFACTLEX'
* (c) Copyright PPC Paris 1986
       ID     #5C      Non supportÅ par le club
       MSG    0
       POLL   0
       ENTRY  FACT
       CHAR   #F
       KEY    'XFACT'
       TOKEN  228      Non supportÅ par le club

MEMERR EQU    #0944D
OUTRES EQU    #0BC84
ARGPR+ EQU    #0E8EB
MP2-15 EQU    #0C43A
D0=AVS EQU    #09B2C
SUBONE EQU    #0C327

       ENDTXT


       NIBHEX 411      --- XFACT(n)=n! ---
FACT   AD0EX           Sauvegarde D0 ds R0
       R0=A
       GOSBVL =D0=AVS  Calcule et sauvegarde ds
       C=0    A        D0 (AVMEMS)+37 en vue
*                      d'une
       LC(2)  2*16+5   utilisation ultÅrieure
       A=A+C  A
       D0=A
       GOSBVL =ARGPR+  Recherche et prÅpare n
       GOSUB  XFACT    Calcule n! si n#0 et n#1
       C=R0            Remet D0 en place
       D0=C
       GOVLNG =OUTRES  Retourne n!


Memerr GOVLNG =MEMERR
XFACT  CD1EX           Y-a-t-il suffisement de
       D1=C            place sur la pile pour
       AD0EX           sauvegarder
*                      l'environnement
       ?C<=A  A        courant?
       GOYES  Memerr   Non
       AD0EX
       D1=D1- 5        Sauvegarde L0
       C=RSTK
       DAT1=C A
       D1=D1- 16       Sauvegarde A(W)
       DAT1=A W
       D1=D1- 16       Sauvegarde B(W)
       C=B    W
       DAT1=C W
       GOSBVL =SUBONE  PrÅpare le calcul de
*                      (n-1)!
       P=     14
       ?B=0   WP       Si n est nul,
       GOYES  ZERO     alors n!=0;
       GOSUB  XFACT    sinon n!=n*(n-1)!
XFACT* C=DAT1 W        A ce point (A,B)=(n-1)!
       D=C    W        RÅcupÅrons n dans (C,D)
       D1=D1+ 16
       C=DAT1 W
       D1=D1+ 16
       GOSBVL =MP2-15  Puis calculons n*(n-1)!
       C=DAT1 A        Rendons la main È la
       RSTK=C          routine appelante
       D1=D1+ 5
       RTN

ZERO   D1=D1+ 16       On n'a pas 0!=0,
       D1=D1+ 16
       D1=D1+ 5
       A=0    W        mais 0!=1
       B=0    W
       B=B+1  P        (Rappelons que P=14)
       GOTO   XFACT*

       END