LEX    'FINDLEX'
* (c) Coyright PPC-Paris et l'Auteur 1987
**************************************************
* FIND <chaine-alphanumerique>
* permet de trouver, dans un fichier Basic la
* premiere occurence de la chaine specifiee
* apres la ligne courante.
* Historique:
*  01/86 J.J. Moreau
*        conception et premiere version
*  12/86 J. Taillandier
*        - debogage
*        - suppression du message d'erreur dans
*          cette version "autonome"
*        - positionement du curseur sur la
*          chaine trouvee
**************************************************
        ID     #E1
        MSG    0
        POLL   0
        ENTRY  Find
        CHAR   #7
        KEY    'FIND'
        TOKEN  75
=AVE=D1 EQU   #18BB8
=BF2DSP EQU   #01C0E
=BLDDSP EQU   #01898
=BSERR  EQU   #0939A
=CK"ON" EQU   #076AD
=CSLW5  EQU   #0ED3D
=CSRW5  EQU   #0ED2C
=CURRL  EQU   #2F7E8
=CURSRT EQU   #096C1
=DSPCNO EQU   #09716
=EXPEXC EQU   #0F186
=FINDL  EQU   #0FFE4
=GETPRO EQU   #06BEE
=GETSTC EQU   #07726
=LDCM10 EQU   #04F6F
=LDCOMP EQU   #04F69
=LDCSPC EQU   #2F6C1
=MAIN30 EQU   #0037E
=MFERR  EQU   #09393
=NULLP  EQU   #07999
=NXTLIN EQU   #10031
=NXTSTM EQU   #08A48
=OUTBS  EQU   #2F58F
=REVPOP EQU   #0BD31
=S-R1-2 EQU   #2F88B
=S-R1-3 EQU   #2F890
=STRNGP EQU   #0379D
=eFTYPE EQU   #0003F
=eNFOUN EQU   232
        ENDTXT

 Strngp GOVLNG =STRNGP

        REL(5) Strngp   pas de decompile, FIND
          *             est non programmable
 Find   GOSBVL =EXPEXC  depose "search" sur la MS
        GOSBVL =REVPOP  renverse search
        ?A=0   A        LEN(search)=0 ?
        GOYES  NStrng   oui, erreur
        D0=(5) =S-R1-2  S-R1-2 := LEN(search)
        DAT0=A A
        CD1EX           ^ search
        D1=C
        D0=D0+ 5        D0 := ^ S-R1-3
        DAT0=C A        S-R1-3 := ^ search
        GOSBVL =AVE=D1  AVMEME := D1

        GOSBVL =GETPRO  fichier prive ?
        GOC    Mferr    oui, erreur
        GOSBVL =GETSTC  fichier Basic ?
        GONC   Find20   oui
        LC(2)  =eFTYPE  non, erreur
 Mferr  GOVLNG =MFERR
 Find20 GOSBVL =NULLP   fichier vide ?
        GONC   Find30   non
 NStrng P=     0        erreur 'Not Found'
        LC(4)  =eNFOUN
        GOVLNG =BSERR
 Find30 D1=(5) =CURRL   positionnement ..
        C=0    A        .
        C=DAT1 4        .
        GOSBVL =FINDL   .. ligne courante
        GONC   NStrng   non trouvee
        CD1EX           C[A] := ^ numero de ligne
        B=C    A        sauve dans B[A]
        CD1EX           restaure D1
        GOSBVL =NXTLIN  ligne suivante
        ?C<D   A        avant fin de fichier ?
        GOYES  Find15   oui
        A=B    A        non, on commence a la ..
        D1=A            .. ligne courante
 Find15 C=D    A        C[A] := ^ fin fichier
        GOSBVL =CSLW5
        CD1EX           C[A] := ^ debut de ligne
        D1=C            D1 := ^ debut de ligne
 Findx  R3=C            sauvegarde des pointeurs
          *             de fichier dans R3
        GOSBVL =LDCM10  decompile la ligne
* A ce stade :
*   (OUTBS) ^ ligne decompilee ("objet")
*   B[A] = LEN(object) en octets
*   P indetermine
*
*   S-R1-2  = LEN(search)
*   S-R1-3  = ^ search
*   R3[9:5] = ^ debut de ligne courante
*   R3[4:0] = ^ fin de fichier
 Find40 P=     0        par securite
* Comme la recherche porte simplement sur la
* partie utile de la ligne, excluant le numero de
* ligne, il faut actualiser la longueur de la
* ligne
        C=0    W
        D0=(5) =OUTBS
        A=DAT0 A        A[A] := ^ debut de ligne
        D0=(4) =LDCSPC
        C=DAT0 A        C[A] := ^ espace apres
          *             numero de ligne
        C=C-A  A
        CSRB            longueur en octets
        C=C+1  A        + 1 espace
        A=B    A        A[A] longueur totale
        A=A-C  A        A[A] := longueur sans
          *             en-tete
        B=A    A        B[A] := longueur utile
        A=A+A  A        A[A] := longueur en nibs
        C=DAT0 A        C[A] := ^ objet
        R2=C            R2 := ^ objet
        D1=C            D1 := ^ objet
        D0=(5) =S-R1-3  .
        C=DAT0 A        .
        R1=C            R1 := ^ search
        D0=D0- 5        D0 ^ S-R1-2
        C=DAT0 A        C[A] := LEN(search)
* A ce stade :
*  A[A] = LEN(objet)
*  R2   = ^ objet
*  C[A] = LEN(search)
*  R1   = ^ search
* Le code est inspire de POS et STREQL mais ces
* deux sous-programmes travaillent sur des chaines
* "inversees" (premier caractere en adresse haute)
* Ici le premier caractere est en adresse basse.
* La chaine est divisÅe en n blocs de 16 quartets
* et un reste.
        A=A-C  A
        GOC    Pos5     LEN(objet)<LEN(search)
        C=C-1  A        LEN(search)-1
        P=C    0        RMD(Len(search$)-1,16)
         *                -> reste
        CSR    A        DIV(Len(search$)-1,16)
        D=C    A          -> n
        GONC   Pos3     B.E.T.
 Pos2   C=B    A
        RSTK=C          Scanindex -> Stack;
        CD1EX
        RSTK=C          Scanpt -> Stack;
        CD1EX
        C=D    A
        B=C    A        B[A] := n
        GOSUB  streql   compare search avec la --
          *             suite de objet           |
        C=RSTK                                   |
        D1=C            restaure D1              |
        C=RSTK                                   |
        B=C    A        restaure B[A]            v
        GONC   Pos6     search incluse dans objet
        B=B-1  A        utilise plus loin -------
 Pos3   C=R1            ^ search                 |
        D0=C            D0 := ^ search           |
        GOC    Pos5     objet est analyse <------
        A=DAT0 B        A[B] := premier caractere
          *             de search
 Pos4   D1=D1+ 2        caractere suivant de objet
        C=DAT1 B        C[B] := caractere suivant
        ?A=C   B
        GOYES  Pos2     debut d'egalite
        B=B-1  A        reste-t-il des caracteres
        GONC   Pos4     oui
 Pos5   A=R2            sortie
        D1=A            pour avoir 0 plus loin
 Pos6   A=R2
        C=0    W
        C=A    A        A[A] := ^ objet
        AD1EX           D1 := ^ premier caractere
        A=A-C  A
* A[A] contient le deplacement (dans objet)
* pour lequel on a trouve search dans objet.
* Si cette valeur est non nulle on va afficher la
* ligne
        P=     0
        C=R3
        D1=C            D1 := ^ debut de ligne
        ?A=0   A        a-t-on trouve search ?
        GOYES  Find60   non
* On affiche la ligne.
* Il faudra positionner le curseur sur le
* premier caractere ou on trouve search
        R3=A            R3 := deplacement
        GOSBVL =LDCOMP  Decompile la ligne pointee
          *             par D1; elle devient
          *             ligne courante
        D0=(5) =OUTBS
        C=DAT0 A
        D0=C            D0 := ^ premier caractere
        D1=(5) =LDCSPC
        A=0    M
        A=DAT1 A        A[A] := ^ espace apres le
          *             numero de ligne
        A=A-C  A
        C=R3            C[A] := deplacement
        A=A+C  A        ajoute a l'offset
        ASRB            converti en octets
        R0=A            sauve dans R0
        C=B    A        2*LEN(ligne)
        RSTK=C          sauvegarde
        GOSUB  Find*
        NIBHEX B1C3     curseur eteint
        NIBASC '>'      '>'
        NIBHEX B1E3     curseur allume
        NIBHEX FF       fin de sequence
 Find*  C=RSTK          C[A] := ^ debut sequence
        D1=C
        GOSBVL =BF2DSP  affiche la sequence
        C=RSTK          B[A] := 2*LEN(ligne)
        B=C    A
        GOSBVL =DSPCNO  affiche buffer de sortie
        C=R0            nombre de curseur a droite
        GOSBVL =CURSRT  execution ...
        GOSBVL =BLDDSP  construit l'affichage
        GOVLNG =MAIN30  retour a Basic
* on n'a rien trouve sur la ligne courante, on
* essaie de passer a la ligne suivante.
 Find60 GOSBVL =CSRW5
        D=C    A        D[A] := ^ fin de fichier
        GOSBVL =NXTLIN  passage ligne suivante
        P=     0
        ?C<D   A        dans le fichier ?
        GOYES  Find70   oui
        GOTO   NStrng    fin de fichier et rien
          *             trouve
* on va passer a la ligne suivante, on remet les
* pointeurs en place et on verifie que
* l'utilisateur n'a pas appuye sur [ON].
 Find70 C=R3            .
        CD1EX           .
        R3=C            restaure R3
        GOSBVL =CK"ON"  verifie [ON] ------------
        C=R3                                     |
        D1=C            D1 := ^ numero de ligne  |
        GOC    Findx+   [ON] non demande <------
        GOVLNG =NXTSTM  si demande, fin
 Findx+ GOTO   Findx    recommencons ...
 morest A=DAT0 W
        C=DAT1 W
        ?A#C   W
        RTNYES          # retour Carry Set
        D0=D0+ 16       ^ mot suivant
        D1=D1+ 16
 streql B=B-1  A        termine avec les mots
          *             complets
        GONC   morest   non
 tailst A=DAT0 WP       test sur le reste
        C=DAT1 WP
        ?A#C   WP
        RTNYES
        RTNCC
        END