'forbas2
   '       29/11/1990


    DEFINT A-Z
    DECLARE FUNCTION lettre (c$)
    DECLARE FUNCTION chiffre (c$)
    DECLARE SUB lire ()
    DECLARE SUB lire0 ()
    DECLARE FUNCTION estmocle (mot$)
    DECLARE FUNCTION operateur (c$)
    DECLARE FUNCTION etiquette$ (ll$)
    DECLARE FUNCTION commentaire (Ligne$)
    DECLARE SUB accept ()
    DECLARE SUB generer (mot$)
    DECLARE SUB message (mes$)
    DECLARE SUB expression ()
    DECLARE SUB simple.expression ()
    DECLARE SUB terme ()
    DECLARE SUB facteur ()
    DECLARE SUB constante ()
    DECLARE SUB variable ()
    DECLARE FUNCTION bonne.etiquette (ll$)
    DECLARE SUB pretraitement ()
    DECLARE SUB voir.programme (nl, programme$())
    DECLARE SUB rajouter.ligne (Ligne$, nl, numl, programme$())
    DECLARE SUB decaler (ll$, n)
    DECLARE SUB traite.etiquettes (nbe, file(), nbgt, emplacgoto(), nl, programme$(), debut)
    DECLARE SUB change.etiquettes (nbe, file(), nbgt, emplacgoto(), nl, programme$())
    DECLARE SUB transfo.do (nbe, file(), nbgt, emplacgoto(), nl, programme$())
    DECLARE SUB rajoute.etiquettes (nbe, file(), nl, programme$())
    DECLARE SUB decale.boucles (nbe, file(), nl, programme$())
    DECLARE SUB substitue (l0$, elem0$, elems$, ls$)
    DECLARE FUNCTION str2$ (x)
    DECLARE SUB minuscules (nl, programme$())
    DECLARE SUB traite.formats (nl, programme$(), nbf, format$(), emplac.format())
    DECLARE SUB decoupe (lg$, emplac, gauche$, droite$)
    DECLARE SUB transfo.format (form$, form2$)
    DECLARE SUB acceptf ()
    DECLARE SUB liref ()
    DECLARE SUB sauver.programme (nom$, nl, programme$())

    CONST motcle = 1, ident = 2, oper = 3, xconst = 4
    CONST pgauche = 5, pdroite = 6, virgule = 7, egale = 8
    CONST ficent = 2, imprimante = 4, ecran = 5, ficsort = 3
    CONST vrai = -1, faux = 0, maxmotcles = 50
    CONST formath = 1, formatx = 2, formatf = 3, formati = 4, formate = 6
    CONST parg = 8, pard = 9, chaincar = 10

    DIM denotype$(10), denoform$(10)
    DIM tabmotcle$(50)
    DIM piletiq(50), pileligne(50), file(50, 3)
    DIM emplacgoto(50, 3), rajout.ligne(50, 3), emplac.format(50, 1)
    DIM carlu AS STRING * 1, ncarlu AS STRING * 1
    REM $DYNAMIC
    DIM programme$(2500), format$(150)

    denotype$(1) = "mot cl‚ "
    denotype$(2) = "identificateur"
    denotype$(3) = "op‚rateur"
    denotype$(4) = "constante"
    denotype$(5) = "parent. gauche"
    denotype$(6) = "parent. droite"
    denotype$(7) = "virgule"
    denotype$(8) = "egale"

    denoform$(1) = "Format H"
    denoform$(2) = "Format X"
    denoform$(3) = "Format F"
    denoform$(4) = "Format I"
    denoform$(5) = "Format E"
    denoform$(7) = "virgule"
    denoform$(8) = "par gauche"
    denoform$(9) = "par droite"
    denoform$(10) = "chaine caractŠres"

    tabmotcle$(1) = "DO"
    tabmotcle$(2) = "CONTINUE"
    tabmotcle$(3) = "WRITE"
    tabmotcle$(4) = "READ"
    tabmotcle$(5) = "IF"
    tabmotcle$(6) = "ENDIF"
    tabmotcle$(7) = "GO TO"
    tabmotcle$(8) = "GOTO"
    tabmotcle$(9) = "READ"
    tabmotcle$(10) = "SQRT"
    tabmotcle$(11) = "SUBROUTINE"
    tabmotcle$(12) = "CALL"

    OPEN "lpt1:" FOR OUTPUT AS #imprimante
    OPEN "scrn:" FOR RANDOM AS #ecran

    sortie = ecran'imprimante'ecran'imprimante' ecran' imprimante' ecran

    CLS
      ''GOSUB essais
      PRINT : PRINT
      INPUT "Nom du programme : "; nomprog$
      PRINT : PRINT "un moment ...."
      debut = -1
      'OPEN "i", #ficent, "SELECD2.FOR"'INVMAT.FOR"
      OPEN "i", #ficent, nomprog$ + ".FOR"
      pretraitement
      'traite.formats nl, programme$(), nbf, format$(), emplac.format()
      'END
      'voir.programme nl, programme$()
      'END
      traite.etiquettes nbe, file(), nbgt, emplacgoto(), nl, programme$(), debut
      'END
      change.etiquettes nbe, file(), nbgt, emplacgoto(), nl, programme$()
      'END
      '''voir.programme nl, programme$()
      'END
      ''rajoute.etiquettes nbe, file(), nl, programme$()
      '''END
      '''voir.programme nl, programme$()
      '''decale.boucles nbe, file(), nl, programme$()
      '''PRINT ">>>"; nbe
      '''END
      transfo.do nbe, file(), nbgt, emplacgoto(), nl, programme$()
      'voir.programme nl, programme$()
      'END
      traite.formats nl, programme$(), nbf, format$(), emplac.format()
      'CLS
      'voir.programme nl, programme$()
      'sauver.programme nomprog$, nl, programme$()
      'END
      minuscules nl, programme$()
      sauver.programme nomprog$, nl, programme$()
      CLS
      voir.programme nl, programme$()
    END

essais:
        form$ = "1H ,28X,1X,A,'LA DISTANCE EST NOTEE DELTA')"
        transfo.format form$, form2$: PRINT form$: PRINT form2$: a$ = INPUT$(1)
        END
        form$ = "1H0,I4,6X,I4,7X,F6.3,15X,F6.3,24X,F6.3,7X,F6.3,19X,F6.3,16X,I4"
        transfo.format form$, form2$: PRINT form$: PRINT form2$: a$ = INPUT$(1)
        form$ = " ('seuil de discrimination: s = ',F7.3,5X,'toto = ',I8) "
        transfo.format form$, form2$: PRINT form$: PRINT form2$: a$ = INPUT$(1)
      END

REM $STATIC
'
'
'
'
    SUB accept
      SHARED carlu AS STRING * 1, ncarlu AS STRING * 1
      SHARED token$, ntoken$, ntipe, strlu$
      SHARED bavard, sortie
      SHARED denotype$()
      SHARED fini

debutaccept:
       'PRINT "dans accep,fini = "; fini
       IF (fini) THEN EXIT SUB
       'PRINT "dans accept"
       WHILE (carlu = " " OR carlu = CHR$(13) OR carlu = CHR$(10))
         lire
         'PRINT "apres lire"
         'IF (fini) THEN EXIT SUB
       WEND
       token$ = ntoken$
       ntoken$ = ""
       IF (lettre(carlu)) THEN
          WHILE (lettre(carlu) OR chiffre(carlu))
            ntoken$ = ntoken$ + strlu$
            lire
          WEND
          IF (NOT (estmocle(ntoken$))) THEN
              ntipe = ident
           ELSE
              ntipe = motcle
          END IF
        ELSEIF (chiffre(carlu)) THEN
           ntipe = xconst
           WHILE ((chiffre(carlu)) OR (carlu = "."))
             ntoken$ = ntoken$ + strlu$
             lire
          WEND
        ELSEIF (operateur(carlu)) THEN
           ntoken$ = strlu$
           ntipe = oper
           lire
        ELSEIF (carlu = "(") THEN
           ntoken$ = "("
           ntipe = pgauche
           lire
        ELSEIF (carlu = ")") THEN
           ntoken$ = ")"
           ntipe = pdroite
           lire
        ELSEIF (carlu = ",") THEN
           'PRINT "$$$"
           ntoken$ = ","
           ntipe = virgule
           lire
        ELSEIF (carlu = "=") THEN
           ntoken$ = "="
           ntipe = egale
           lire
       END IF
       IF (bavard) THEN
          PRINT #sortie, "... token$   = "; token$
          PRINT #sortie, "+++ ntoken$  = "; ntoken$
          PRINT #sortie, "--- type      = "; denotype$(ntipe)
          PRINT #sortie, ""
          IF (sortie = ecran) THEN a$ = INPUT$(1)
       END IF
   END SUB

'
'
'
'
    SUB acceptf
      SHARED carlu AS STRING * 1, ncarlu AS STRING * 1
      SHARED token$, ntoken$, ntipe, strlu$
      SHARED bavard, sortie
      SHARED denotype$()
      SHARED fini
        IF (fini) THEN EXIT SUB
        WHILE (carlu = " ")
          liref
        WEND
        token$ = ntoken$
        ntoken$ = ""
        IF (carlu = "'") THEN
           ntipe = chaincar
           WHILE ((carlu <> ",")) AND NOT (fini) '$$$
             ntoken$ = ntoken$ + strlu$
             liref
           WEND
         ELSEIF (chiffre(carlu)) THEN
           WHILE ((chiffre(carlu)))
              ntoken$ = ntoken$ + strlu$
              liref
           WEND
           SELECT CASE carlu
               CASE "H"
                 ntipe = formath
               CASE "X"
                 ntipe = formatx
               CASE ELSE
           END SELECT
           WHILE ((carlu <> ",") AND (NOT (fini)))
              ntoken$ = ntoken$ + strlu$
              liref
           WEND
         ELSEIF carlu = "," THEN
            ntoken$ = ","
            ntipe = virgule
            liref
         ELSEIF carlu = "(" THEN
            ntoken$ = "("
            ntipe = parg
            liref
         ELSEIF carlu = ")" THEN
            ntoken$ = ""
            ntipe = pard
            liref
         ELSEIF (carlu = "F") THEN
            ntipe = formatf
            ntoken$ = "F"'"
            liref
            WHILE ((chiffre(carlu)) OR (carlu = "."))
              ntoken$ = ntoken$ + strlu$
              liref
           WEND
         ELSEIF (carlu = "I") THEN
            ntipe = formati
            ntoken$ = "I"'"
            liref
            WHILE ((chiffre(carlu)))
               ntoken$ = ntoken$ + strlu$
              liref
           WEND
         ELSE
           liref
       END IF
    END SUB

'
'
'
'
     FUNCTION bonne.etiquette (ll$)
         bonne.etiquette = (INSTR(ll$, "CONTINUE") <> 0)
     END FUNCTION

'
'
'
'
    SUB change.etiquettes (nbe, file(), nbgt, emplacgoto(), nl, programme$())
       FOR i = 1 TO nbe
          etiq$ = str2$(file(i, 2))
          etiq2$ = str2$(file(i, 3))
          l1 = file(i, 0)
          'l2 = file(i, 1)
          'PRINT etiq$, etiq2$: a$ = INPUT$(1)
          substitue programme$(l1), etiq$, etiq2$, ls$
          programme$(l1) = ls$
          'PRINT programme$(l1)': a$ = INPUT$(1)
          l2 = file(i, 1)
          ls$ = etiq2$ + STRING$(5 - LEN(etiq2$), " ") + " CONTINUE"
          'substitue programme$(l2), etiq$, etiq2$, ls$
          programme$(l2) = ls$
          '''PRINT programme$(l2)
          ''a$ = INPUT$(1)
      NEXT i
      FOR i = 1 TO nbgt
          etiq$ = str2$(emplacgoto(i, 1))
          etiq2$ = str2$(emplacgoto(i, 2))
          l1 = emplacgoto(i, 0)
          'PRINT etiq$, etiq2$: a$ = INPUT$(1)
          ''PRINT "avant substitution : "
          ''PRINT programme$(l1)
          substitue programme$(l1), etiq$, etiq2$, ls$
          programme$(l1) = ls$
          ''PRINT "aprŠs subtitution : "
          ''PRINT programme$(l1): a$ = INPUT$(1)
          l2 = emplacgoto(i, 3)
          IF (l2 > 0) THEN
             ''PRINT "avant substitution : "
             ''PRINT programme$(l2)
             substitue programme$(l2), etiq$, etiq2$, ls$
             programme$(l2) = ls$
             ''PRINT "aprŠs subtitution : "
             ''PRINT programme$(l2): a$ = INPUT$(1)
          END IF
      NEXT i
    END SUB

'
'
'
    FUNCTION chiffre (c$)
      chiffre = (INSTR("0123456789", c$) <> 0)
    END FUNCTION

'
'
'
'
    FUNCTION commentaire (Ligne$)
       commentaire = (LEFT$(ll$, 1) = "C")
    END FUNCTION

'
'
'
    SUB constante
      SHARED token$
      SHARED fini
         'IF (fini) THEN EXIT SUB
         message "constante"
         accept
         IF (fini) THEN EXIT SUB
         generer token$
    END SUB

'
'
'
'
    SUB decale.boucles (nbe, file(), nl, programme$())
         FOR i = 1 TO nbe
           'PRINT file(i, 0), file(i, 1), file(i, 2)
           IF (file(i, 1) > file(i, 0)) THEN
              FOR j = file(i, 0) + 1 TO file(i, 1) - 1
                decaler programme$(j), 3
              NEXT j
           END IF
         NEXT i
         FOR i = 1 TO nbe
           'PRINT file(i, 0), file(i, 1), file(i, 2)
           IF (file(i, 1) = 0) THEN
              etiq = file(i, 2)
              deb = file(i, 0) + 1
              'PRINT etiq, deb: a$ = INPUT$(1)
              FOR j = 1 TO nbe
                 IF (file(j, 2) = etiq) THEN
                    fin = file(j, 1) - 1
                    'PRINT ">>>"; fin: END
                    FOR k = deb TO fin
                       decaler programme$(k), 3
                    NEXT k
                  END IF
              NEXT j
           END IF
         NEXT i
    END SUB

'
'
'
'
    SUB decaler (ll$, n)
       lg = LEN(ll$)
       ''PRINT ll$
       IF (INSTR(ll$, "'") = 0) THEN
         IF (lg > 5) THEN
           ll$ = LEFT$(ll$, 6) + STRING$(n, " ") + RIGHT$(ll$, lg - 6)
         END IF
        ELSE
           ll$ = STRING$(n, " ") + ll$
       END IF
    END SUB

'
'
'
    SUB decoupe (lg$, emplac, gauche$, droite$)
        gauche$ = LEFT$(lg$, emplac - 1)
        droite$ = RIGHT$(lg$, LEN(lg$) - emplac)
    END SUB

'
'
'
'
    FUNCTION estmocle (mot$)
      SHARED tabmotcle$()
         FOR i = 1 TO maxmotcles
             IF (mot$ = tabmotcle$(i)) THEN
                estmocle = vrai
                EXIT FUNCTION
             END IF
         NEXT i
         estmocle = faux
    END FUNCTION

'
'
'
'
    FUNCTION etiquette$ (ll$)
        etiquette$ = (LEFT$(ll$, 6))
    END FUNCTION

'
'
'
'
    SUB expression
      SHARED ntipe, token$, ntoken$
      SHARED fini
      SHARED nbgauche, nbdroit
        message "expression"
        simple.expression
        IF (fini) THEN
           IF (ntoken$ <> ")") THEN generer ntoken$
           EXIT SUB
        END IF
     END SUB

'
'
'
'
    SUB facteur
      SHARED ntipe, ntoken$
      SHARED fini
           IF (fini) THEN EXIT SUB
           message "facteur"
           IF (ntipe = xconst) THEN
              constante
            ELSEIF (ntipe = ident) THEN
              variable
            ELSEIF (ntoken$ = "(") THEN
              generer "("
              accept
              expression
              IF (ntoken$ = ")") THEN
                 generer ")"
                 accept
                 LOCATE 10, 1: PRINT ntoken$
                 'generer ")"
              END IF
           END IF
    END SUB

'
'
'
'
    SUB generer (mot$)
      SHARED lignexp$
      SHARED nbgauche, nbdroit
        IF (mot$ = "(") THEN nbgauche = nbgauche + 1
        IF (mot$ = ")") THEN nbdroit = nbdroit + 1
        lignexp$ = lignexp$ + mot$
        '''LOCATE 15, 1: PRINT lignexp$: a$ = INPUT$(1)
    END SUB

'
'
'
'
    FUNCTION lettre (c$)
       code = ASC(c$)
       'PRINT code
       lettre = (((code > 64) AND (code < 91)) OR ((code > 97) AND (code < 123)))
    END FUNCTION

'
'
'
    SUB lire
      SHARED carlu AS STRING * 1, ncarlu AS STRING * 1, strlu$
      SHARED token$, ntokens, ntipe
      SHARED bavard
      SHARED fichier
      'PRINT "dans lire, fichier = ", fichier: END
      IF (NOT (fichier)) THEN lire0: EXIT SUB
      carlu = ncarlu
      ncarlu = INPUT$(1, #entree)
      IF (NOT (bavard)) THEN
         IF (strlu$ <> CHR$(10)) THEN PRINT #sortie, strlu$
      END IF
    END SUB

'
'
'
'
    SUB lire0
      SHARED carlu AS STRING * 1, ncarlu AS STRING * 1, strlu$
      SHARED prog$, curseur, lenprog
      SHARED fini
        carlu = ncarlu
        curseur = curseur + 1
        fini = (curseur > lenprog)
        ncarlu = MID$(prog$, curseur, 1)
        'PRINT "$", ncarlu, ASC(ncarlu): a$ = INPUT$(1)
        strlu$ = carlu
    END SUB

'
'
'
'
     SUB liref
      SHARED carlu AS STRING * 1, ncarlu AS STRING * 1, strlu$
      SHARED form$, curf, lenform
      SHARED fini
         carlu = ncarlu
         curf = curf + 1
         fini = (curf > lenform)': PRINT fini: a$ = INPUT$(1)
         ncarlu = MID$(form$, curf, 1)
         strlu$ = carlu
         'PRINT ">"; carlu: a$ = INPUT$(1)
     END SUB

'
'
'
'
    SUB message (mes$)
      EXIT SUB
      LOCATE 4, 1
      PRINT STRING$(60, " ")
      LOCATE 4, 1
      PRINT ">>> "; mes$: a$ = INPUT$(1)
    END SUB

'
'
'
'
    SUB minuscules (nl, programme$())
        FOR i = 1 TO nl
          programme$(i) = LCASE$(programme$(i))
        NEXT i
    END SUB

'
'
'
'
    FUNCTION operateur (c$)
       operateur = (INSTR("-+*/^", c$) <> 0)
    END FUNCTION

'
'
'
'
    SUB pretraitement
      SHARED programme$()
      SHARED nl
        nl = 0
        ii = 0
        WHILE NOT (EOF(ficent))
          LINE INPUT #ficent, ll$
          ll$ = UCASE$(ll$)
          ii = ii + 1
          substitue ll$, ".LT.", " < ", ll$
          substitue ll$, ".GT.", " > ", ll$
          substitue ll$, ".LE.", " <= ", ll$
          substitue ll$, ".GE.", " >= ", ll$
          substitue ll$, ".EQ.", " = ", ll$
          substitue ll$, ".OR.", " OR ", ll$
          substitue ll$, ".AND.", " AND ", ll$
          substitue ll$, ".NE.", " <> ", ll$
          substitue ll$, "ENDIF", "END IF", ll$
          substitue ll$, "GO TO", "GOTO", ll$
          substitue ll$, "DIMENSION", "DIM", ll$
          substitue ll$, "SUBROUTINE", "SUB", ll$
          '''IF (ii < 5) THEN substitue ll$, "SUBROUTINE", "SUB", ll$
          IF (LEFT$(ll$, 1) = "C") THEN
             IF (LEN(ll$) = 1) THEN
                substitue ll$, "C", " ", ll$
               ELSE
                substitue ll$, "C", "'", ll$
              END IF
             ll$ = STRING$(6, " ") + ll$
          END IF
          IF (VAL(LEFT$(ll$, 5)) = 0) OR (INSTR(ll$, "FORMAT") <> 0) THEN
             ' PRINT etiquette$(ll$)
             'GOSUB comment
             nl = nl + 1: programme$(nl) = ll$
             'PRINT ll$: a$ = INPUT$(1)
           ELSE
             IF (bonne.etiquette(ll$)) THEN
               nl = nl + 1: programme$(nl) = ll$
               'nl = nl + 1: programme$(nl) = STRING$(10, " ")
               'PRINT ll$: a$ = INPUT$(1)
              ELSE
               l1$ = STRING$(6, " ") + RIGHT$(ll$, LEN(ll$) - 6)
               l2$ = LEFT$(ll$, 6) + "CONTINUE"
               nl = nl + 1: programme$(nl) = l1$
               nl = nl + 1: programme$(nl) = l2$
               'nl = nl + 1: programme$(nl) = STRING$(10, " ")
               'PRINT l1$
               'PRINT l2$: a$ = INPUT$(1)
              END IF
           END IF
        WEND

        EXIT SUB
comment:
        IF (LEFT$(ll$, 1) = "C") THEN
          ll$ = "'" + RIGHT$(ll$, LEN(ll$) - 1)
        END IF
      RETURN

change.etiq:
       'etiq = VAL(LEFT$(ll$, 6))
       'IF (etiq < 10000) THEN netiq = 10000 + etiq

     END SUB

'
'
'
'
    SUB rajoute.etiquettes (nbe, file(), nl, programme$())
      SHARED rajout.ligne()
        nbraj = 0
        FOR i = nbe TO 1 STEP -1
           l2 = file(i, 1)
           IF (l2 = 0) THEN
              etiq = file(i, 3)
              FOR j = i - 1 TO 1 STEP -1
                 IF (etiq = file(j, 3)) THEN
                    nbraj = nbraj + 1
                    rajout.ligne(nbraj, 2) = file(i, 0)
                    rajout.ligne(nbraj, 3) = etiq
                    rajout.ligne(nbraj, 0) = file(j, 1) - 1
                    etiq = etiq - 1
                    rajout.ligne(nbraj, 1) = etiq
                    file(i, 1) = rajout.ligne(nbraj, 0)
                 END IF
              NEXT j
           END IF
        NEXT i
        'GOSUB xvoir.file
        'GOSUB voir.rajout.ligne
        FOR i = 1 TO nbraj
          ancienne$ = str2$(rajout.ligne(i, 3))
          nouvelle2$ = str2$(rajout.ligne(i, 1))
          Ligne = rajout.ligne(i, 2)
          substitue programme$(Ligne), ancienne$, nouvelle2$, ls$
          programme$(Ligne) = ls$
          '''PRINT programme$(l1)': a$ = INPUT$(1)
        NEXT i
        FOR i = nbraj TO 1 STEP -1
           etiq2$ = str2$(rajout.ligne(i, 1))
           Ligne = rajout.ligne(i, 0)
           lr$ = etiq2$ + STRING$(5 - LEN(etiq2$), " ") + " CONTINUE"
           PRINT "aprŠs la ligne "; Ligne; " je rajoute : "
           PRINT lr$
           IF (Ligne > 0) THEN
            rajouter.ligne lr$, nl, Ligne, programme$()
           END IF
           FOR k = 1 TO nbe
              IF (file(k, 0) >= Ligne) THEN
                  file(k, 0) = file(k, 0) + 1
              END IF
              IF (file(k, 1) >= Ligne) THEN
                 file(k, 1) = file(k, 1) + 1
              END IF
           NEXT k
           'GOSUB xvoir.file
           FOR k = 1 TO nbraj
              IF (rajout.ligne(k, 0) > Ligne) THEN
                rajout.ligne(k, 0) = rajout.ligne(k, 0) + 1
              END IF
           NEXT k
           'GOSUB voir.rajout.ligne
        NEXT i
        'GOSUB xvoir.file

        EXIT SUB

voir.rajout.ligne:
        PRINT
        PRINT "rajout ligne :": PRINT
        FOR i2 = 1 TO nbraj
          FOR j2 = 0 TO 3
             PRINT rajout.ligne(i2, j2),
          NEXT j2
          PRINT
        NEXT i2
     RETURN

xvoir.file:
       PRINT "nouvelle file ": PRINT
       FOR i2 = 1 TO nbe
         FOR j2 = 0 TO 3
           PRINT file(i2, j2);
         NEXT j2
         PRINT
         a$ = INPUT$(1)
       NEXT i2
    RETURN

    END SUB

'
'
'
'
    SUB rajouter.ligne (Ligne$, nl, numl, programme$())
       FOR i = nl + 1 TO numl STEP -1
          programme$(i + 1) = programme$(i)
       NEXT i
       programme$(numl + 1) = Ligne$
       nl = nl + 1
    END SUB

'
'
'
'
    SUB sauver.programme (nom$, nl, programme$())
        OPEN "o", ficsort, nom$ + ".BAS"
        FOR i = 1 TO nl
           PRINT #ficsort, programme$(i)
        NEXT i
        CLOSE #ficsort
    END SUB

'
'
'
'
    SUB simple.expression
      SHARED token$, ntoken$
      SHARED fini
        IF (fini) THEN EXIT SUB
        message "simple.expression"
        IF ((ntoken$ = "+") OR (ntoken$ = "-")) THEN
           generer ntoken$
           accept
           terme
         ELSE
           terme
           WHILE (ntoken$ = "+") OR (ntoken$ = "-")
              generer ntoken$
              accept
              terme
           WEND
        END IF
    END SUB

'
'
'
'
    FUNCTION str2$ (x)
         str2$ = RIGHT$(STR$(x), LEN(STR$(x)) - 1)
    END FUNCTION

'
'
'
'
    SUB substitue (l0$, elem0$, elems$, ls$)
      x = INSTR(l0$, elem0$)
      ls$ = l0$
      'PRINT "dans substitue"; x, l0$
      IF (x > 0) THEN
        l = LEN(elem0$)
        ls$ = LEFT$(l0$, x - 1) + elems$ + RIGHT$(l0$, LEN(l0$) - (x + l - 1))
      END IF
      'PRINT ls$
    END SUB

'
'
'
'
    SUB terme
      SHARED ntoken$
      SHARED fini
        IF (fini) THEN EXIT SUB
        message "terme"
        facteur
        WHILE (ntoken$ = "*") OR (ntoken$ = "/")
           generer ntoken$
           accept
           facteur
        WEND
    END SUB

'
'
'
'
    SUB traite.etiquettes (nbe, file(), nbgt, emplacgoto(), nl, programme$(), debut)
      SHARED token$, ntoken$, ntipe, strlu$
      SHARED bavard, sortie
      SHARED denotype$()
      SHARED lignexp$
      SHARED curseur
      SHARED fini, lenprog
      SHARED prog$
      SHARED carlu    AS STRING * 1, ncarlu AS STRING * 1
        nbe = 0
        etiq0 = 10
        pas = 10
        FOR i = 1 TO nl
          eg = INSTR(programme$(i), "GOTO")
          IF (eg <> 0) THEN
             nbgt = nbgt + 1
             emplacgoto(nbgt, 0) = i
             GOSUB xtrouve.goto
             emplacgoto(nbgt, 1) = VAL(ntoken$)
          END IF
          IF (INSTR(programme$(i), "DO ") <> 0) THEN
              '''PRINT ">>>>"; programme$(i)
              '''a$ = INPUT$(1)
              GOSUB trouve.do
              IF (ok) THEN 'si c'est vraie une ligne "DO"
                netiq = VAL(etiq$)
                nbe = nbe + 1
                file(nbe, 0) = i
                file(nbe, 2) = netiq
                'PRINT nbe, netiq: a$ = INPUT$(1)
              END IF
          END IF
          IF (INSTR(programme$(i), "CONTINUE") <> 0) THEN
              GOSUB traite.etiq
          END IF
        NEXT i
        IF (debut) THEN
           GOSUB renome.etiq
           GOSUB renome.goto
           GOSUB complete.goto
        END IF
        'GOSUB voir.file
        'GOSUB voir.emplac.goto

         EXIT SUB

voir.file:
        CLS
        PRINT
        FOR i = 1 TO nbe
            PRINT i, file(i, 0), file(i, 1), file(i, 2), file(i, 3)
        NEXT i
     RETURN

voir.emplac.goto:
       PRINT
       FOR i = 1 TO nbgt
          PRINT programme$(emplacgoto(i, 0))
          PRINT programme$(emplacgoto(i, 3))
          FOR i2 = 0 TO 3: PRINT emplacgoto(i, i2), : NEXT i2: PRINT
       NEXT i
     RETURN

trouve.do:
        'PRINT "trouve do"
        strlu$ = " ": carlu = " ": ncarlu = " "
        token$ = "": ntoken$ = "INIT"
        curseur = 0
        fini = faux
        prog$ = programme$(i)
        'PRINT prog$
        lenprog = LEN(prog$)
        ok = vrai
        accept
        'PRINT ntoken$; " : "; denotype$(ntipe): a$ = INPUT$(1)
        'PRINT ntipe, motcle
        ok = ok AND (ntipe = motcle)  'D0
        accept
        'PRINT ntoken$; " : "; denotype$(ntipe): a$ = INPUT$(1)
        etiq$ = ntoken$             'ETIQUETTE
        ok = ok AND (ntipe = xconst)
        'PRINT "ok = "; ok
     RETURN


traite.etiq:
       netiq = VAL(LEFT$(programme$(i), 6))
       FOR j = 1 TO nbe
         IF (file(j, 2) = netiq) THEN
            file(j, 1) = i
            EXIT FOR
         END IF
       NEXT j
     RETURN


renome.etiq:
     FOR i = 1 TO nbe
       etiq = file(i, 2)
       GOSUB val.etiq
       IF (valeur = 0) THEN
          etiq0 = etiq0 + pas
          valeur = etiq0
       END IF
       file(i, 3) = valeur
     NEXT i
    RETURN

renome.goto:
     FOR i = 1 TO nbgt
       etiq = emplacgoto(i, 1)
       emplacgoto(i, 3) = 0
       GOSUB val.etiq
       '''PRINT etiq, valeur: a$ = INPUT$(1)
       IF (valeur = 0) THEN
          etiq0 = etiq0 + pas
          valeur = etiq0
       END IF
       emplacgoto(i, 2) = valeur
     NEXT i
     RETURN

val.etiq:
     valeur = 0
     FOR k = 1 TO nbe
       IF (file(k, 2) = etiq) THEN
         valeur = file(k, 3)
         EXIT FOR
       END IF
     NEXT k
   RETURN



xtrouve.goto:
        strlu$ = " ": carlu = " ": ncarlu = " "
        token$ = "": ntoken$ = "INIT"
        curseur = 0
        fini = faux
        prog$ = RIGHT$(programme$(i), LEN(programme$(i)) - eg - 4)
        'PRINT ">>> "; prog$: a$ = INPUT$(1)
        lenprog = LEN(prog$)
        ok = vrai
        accept
      RETURN

complete.goto:
       maxetiq = file(nbe, 3)
       'PRINT "maxetiq = "; maxetiq: a$ = INPUT$(1)
       FOR i = 1 TO nl
          ll$ = programme$(i)
          IF (INSTR(programme$(i), "CONTINUE") <> 0) THEN
            eti = VAL(LEFT$(programme$(i), 6))
            'pRINT i; ll$, eti: a$ = INPUT$(1)
            FOR j = 1 TO nbgt
              IF (eti = emplacgoto(j, 1)) THEN
                ' PRINT "eti  "; eti': a$ = INPUT$(1)
                'PRINT "etis "; emplacgoto(j, 2): a$ = INPUT$(1)
                IF (emplacgoto(j, 2) > maxetiq) THEN
                  emplacgoto(j, 3) = i
                END IF
              END IF
            NEXT j
            'NEXT j
          END IF
       NEXT i
    RETURN
  END SUB

'
'
'
'
    SUB traite.formats (nl, programme$(), nbf, format$(), emplac.format())
      SHARED premierf
        i = 1
        debut = vrai
        premierf = 0
        nbf = 0
        DO
          ll$ = programme$(i)
          IF (INSTR(ll$, "FORMAT(") <> 0) THEN
              IF (debut) THEN premierf = i: debut = faux
              nbf = nbf + 1
              'i = i + 1
               'PRINT ll$
              format$(nbf) = ll$
              IF (MID$(programme$(i + 1), 6, 1) <> " ") THEN
                 WHILE (MID$(programme$(i + 1), 6, 1) <> " ")
                   lenp = LEN(programme$(i + 1))
                   format$(nbf) = format$(nbf) + RIGHT$(programme$(i + 1), lenp - 6)
                   i = i + 1
                 WEND
               ELSE
                 i = i + 1
              END IF
            ELSE
              i = i + 1
         END IF
       LOOP UNTIL (i > nl)
       
       IF (premierf = 0) THEN EXIT SUB

       lgp = premierf - 1
       lgp = lgp + 1
       programme$(lgp) = "      END SUB"
       lgp = lgp + 1
       programme$(lgp) = "      "
       FOR i = 1 TO nbf
         f$ = RIGHT$(format$(i), LEN(format$(i)) - 6)
         substitue f$, "FORMAT", "", f$
         DO
            es = INSTR(f$, "/")
            IF (es = 0) THEN
              IF LEN(f$) > 1 THEN
                 transfo.format f$, ft$
                 lgp = lgp + 1
                 programme$(lgp) = "DATA " + CHR$(34) + ft$ + CHR$(34)
                 'PRINT ft$, lgp
              END IF
             ELSE
               decoupe f$, es, gauche$, droite$
               IF (LEN(gauche$) > 1) THEN
                 transfo.format gauche$, gt$
                 lgp = lgp + 1
                 programme$(lgp) = "DATA " + CHR$(34) + gt$ + CHR$(34)
                 'PRINT gt$, lgp
               END IF
               f$ = droite$
            END IF
         LOOP WHILE (es <> 0)
        PRINT
       NEXT i
       'lgp = lgp + 1
       'programme$(lgp) = "      END SUB"
       nl = lgp
     END SUB

'
'
'
'
    SUB transfo.do (nbe, file(), nbgt, emplacgoto(), nl, programme$())
      SHARED strlu$, carlu AS STRING * 1, ncarlu AS STRING * 1
      SHARED token$, ntoken$
      SHARED curseur, fini, lenprog
      SHARED prog$
      SHARED denotype$(), ntipe
        FOR i = 1 TO nbe
            l1 = file(i, 0)
            l2 = file(i, 1)
            ll1$ = programme$(l1)
            ll2$ = programme$(l2)
            ''PRINT ">>"; ll1$
            GOSUB xtraite.do
            '''PRINT ">>>"; ll1$
            programme$(l1) = ll1$
            etiq1 = VAL(LEFT$(ll2$, 6))
            existe = faux
            FOR j = 1 TO nbgt
               IF (etiq1) = emplacgoto(j, 2) THEN existe = vrai
            NEXT j
            '''PRINT ll2$
            eti$ = str2$(etiq1)
            IF (NOT (existe)) THEN
               subs$ = STRING$(LEN(eti$), " ")
               substitue ll2$, eti$, subs$, ll2$
               substitue ll2$, "CONTINUE", "NEXT ", ll2$
             ELSE
               subs$ = eti$ + ":"
               substitue ll2$, eti$, subs$, ll2$
               substitue ll2$, " CONTINUE", "NEXT ", ll2$
            END IF
            ll2$ = ll2$ + var$
            ''PRINT
            ''PRINT ll2$
            programme$(l2) = ll2$
            ''a$ = INPUT$(1)
         NEXT i
        
         EXIT SUB


xtraite.do:
        strlu$ = " ": carlu = " ": ncarlu = " "
        token$ = "": ntoken$ = "INIT"
        curseur = 0: fini = faux
        prog$ = ll1$: lenprog = LEN(prog$)
        accept
        accept
        etiq$ = ntoken$
        accept
        var$ = ntoken$
        substitue ll1$, "DO", "FOR", lls$
        substitue lls$, etiq$, "", ll1$
        substitue ll1$, ",", " TO ", lls$
        substitue lls$, ",", " STEP ", ll1$
      RETURN
    END SUB

'
'
'
'
    SUB transfo.format (f0$, form2$)
      SHARED strlu$, carlu AS STRING * 1, ncarlu AS STRING * 1
      SHARED token$, ntoken$
      SHARED curf, fini, lenform, ntipe
      SHARED form$
        form$ = f0$
        'PRINT : PRINT "format … transformer : ": PRINT
        'PRINT form$
        'PRINT
        'a$ = INPUT$(1)
        strlu$ = " ": carlu = " ": ncarlu = " "
        token$ = "": ntoken$ = "INIT"
        curf = 0: fini = faux
        'form$ = "  1H1 , 45X,I8, F6.3 "
        'form$ = "1H0,I4,6X,I4,7X,F6.3,15X,F6.3,24X,F6.3,7X,F6.3,19X,F6.3,16X,I4"
        'form$ = " ('seuil de discrimination: s = ',F7.3,5X,'toto = ',I8) "
        form2$ = form$
        lenform = LEN(form$)
        DO
          acceptf
          'PRINT ntoken$, ntipe, denoform$(ntipe)
          'a$ = INPUT$(1)
          SELECT CASE ntipe
            CASE virgule
                substitue form2$, ",", "", form2$
            CASE formath
                substitue form2$, ntoken$, "", form2$
            CASE formatx
                substitue form2$, ntoken$, STRING$(VAL(ntoken$), " "), form2$
            CASE formati
                nbi = VAL(RIGHT$(ntoken$, LEN(ntoken$) - 1))
                substitue form2$, ntoken$, STRING$(nbi, "#"), form2$
            CASE formatf
                ep = INSTR(ntoken$, ".")
                nb1 = VAL(MID$(ntoken$, 2, ep))
                IF (nb1 <> 0) THEN
                  nb2 = VAL(MID$(ntoken$, ep + 1, LEN(ntoken$)))
                  subt$ = STRING$(nb1 - nb2 - 1, "###") + "." + STRING$(nb2, "#")
                  substitue form2$, ntoken$, subt$, form2$
                END IF
             CASE chaincar
                substitue form2$, "'", "", form2$
                substitue form2$, "'", "", form2$
                substitue form2$, ",", "", form2$
                'substitue form2$, "'", "", form2$
             CASE parg
                substitue form2$, "(", "", form2$
             CASE pard
                substitue form2$, ")", "", form2$
            CASE ELSE
          END SELECT
        LOOP UNTIL fini
        substitue form2$, ")", "", form2$
        'PRINT form$
        'PRINT form2$
    END SUB

'
'
'
'
    SUB variable
      SHARED token$, ntoken$
      SHARED fini
         IF (fini) THEN EXIT SUB
         message "variable"
         accept
         generer token$

          '''EXIT SUB '$$$
         IF (ntoken$ = "(") THEN
           generer "("
           accept
           expression
           accept
           generer token$ '"("
         END IF
    END SUB

'
'
'
'
    SUB voir.programme (nl, programme$())
      SHARED sortie
      FOR i = 1 TO nl
        'PRINT #sortie, USING "#####: "; i;
        PRINT #sortie, programme$(i)
        IF (sortie = ecran) THEN a$ = INPUT$(1)
     NEXT i
    END SUB