(* 
        
         ********************************************************** 
         ********************************************************** 
         **                                                      ** 
         **                    ls-Warenhaus 4                    ** 
         **                                                      ** 
         **                     Version 1.01                     ** 
         **                                                      ** 
         **                                                      ** 
         **                  (Stand:  30.08.89)                  ** 
         **                                                      ** 
         **                                                      ** 
         **                                                      ** 
         **           Autor: Bruno Pollok, Bielefeld             ** 
         **                                                      ** 
         **    Copyright (C) 1988  Eva Latta-Weber, Bielefeld    ** 
         **    Copyright (C) 1990  ERGOS GmbH, Siegburg          ** 
         **                                                      ** 
         ********************************************************** 
         ********************************************************** 
 
                                                                           *) 
PACKET ls warenhaus 4 DEFINES                        
       uebersetze:
TYPE VOKABEL    = STRUCT (TEXT grin, elan),
     REFINEMENT = STRUCT (TEXT name, INT aufruf);
LET  befehlsanzahl         = 10,
     max refinements       = 20,
     max offene strukturen = 10,
     schleife              =  1,
     abfrage               =  2;
ROW befehlsanzahl VOKABEL CONST befehl :: ROW befehlsanzahl VOKABEL :
    (VOKABEL : ("Artikelnummerlesen",   "artikelnummer lesen"),
     VOKABEL : ("Artikeldateneingeben", "artikeldaten eingeben"),
     VOKABEL : ("Kundennummerlesen",    "kundennummer lesen"),


     VOKABEL : ("Kundendateneingeben",  "kundendaten eingeben"),
     VOKABEL : ("Rechnungskopf",        "rechnungskopf"),
     VOKABEL : ("Artikelkaufen",        "artikel kaufen"),
     VOKABEL : ("Abrechnung",           "abrechnung"),
     VOKABEL : ("Auskunft",             "auskunft"),
     VOKABEL : ("neuesBlatt",           "neues blatt"),
     VOKABEL : ("Bildschirmneu",        "bildschirm neu"));
ROW max refinements REFINEMENT VAR refinement;
ROW max offene strukturen  INT VAR offene struktur;


INT VAR zeilennummer, erster fehler;
OP := (VOKABEL VAR links, VOKABEL CONST rechts):
   CONCR (links) := CONCR (rechts)
END OP :=;
PROC uebersetze (TEXT CONST dateiname):
forget ("elanprogramm", quiet);
FILE VAR quelle :: sequential file (input, dateiname),
         ziel   :: sequential file (output, "elanprogramm");
suche programmanfang;
WHILE NOT (eof (quelle) OR anything noted) REP
  bearbeite zeile
PER;
IF NOT anything noted
   THEN abschlusspruefung
FI;
IF anything noted
   THEN quelle := sequential file (modify, dateiname);


        to line (quelle, erster fehler);
        col (1);
        noteedit (quelle);
        errorstop ("")
FI.
abschlusspruefung:
  IF anzahl refinements > 0
     THEN pruefe refinementliste
     ELSE pruefe programmende
  FI.
pruefe programmende:
  IF programmende fehlt
     THEN zeilennummer INCR 1;
          fehler (16)
  FI.
pruefe refinementliste:
  zeilennummer INCR 1;
  pruefe auf offene schleife oder abfrage;
  put (ziel, "END PROC refinement " + text (letztes refinement));


  FOR index FROM 1 UPTO anzahl refinements REP
    IF refinement [index].aufruf > 0
       THEN zeilennummer := refinement [index].aufruf;
            fehler (25)
    ELIF refinement [index].aufruf < 0
       THEN zeilennummer := - refinement [index].aufruf;
            fehler (26)
    FI
  PER.
suche programmanfang:
  TEXT VAR restzeile, zeile :: "";
  BOOL VAR programmende fehlt := FALSE,
           refinement muss folgen := FALSE;
  INT VAR anzahl refinements := 0,
          letztes refinement := 0,


          letzte geoeffnete  := 0,
          index;
  zeilennummer       := 0;
  erster fehler      := 0;
  WHILE NOT eof (quelle) AND zeile = "" REP
    getline (quelle, zeile);
    zeile := compress (zeile);
    zeilennummer INCR 1;
    cout (zeilennummer);
    IF zeile = "" THEN line (ziel) FI;
  PER;
  put (ziel, "bildschirm neu;");
  IF zeile = "" THEN LEAVE uebersetze
  ELIF pos (zeile, "PROGRAMM") = 1
       THEN programmende fehlt := TRUE
       ELSE fehler (1)
  FI.
bearbeite zeile:


  zeilennummer INCR 1;
  cout (zeilennummer);
  getline (quelle, zeile);
  zeile := compress (zeile);
  change all (zeile, " ", "");
  IF zeile = ""
     THEN line (ziel)
     ELSE analysiere und uebersetze
  FI.
analysiere und uebersetze:
  IF refinement muss folgen
     THEN erstes refinement
     ELSE pruefe zunaechst auf schluesselworte;
          durchsuche befehlsliste
  FI.
erstes refinement:
  IF pos (zeile, ":") = 0
     THEN fehler (19)
  ELIF pos (zeile, ":") < length (zeile)


     THEN fehler (20)
  ELIF (pos (zeile, "PROGRAMM")   = 1) OR
       (pos (zeile, "ENDE")       = 1) OR
       (pos (zeile, "WIEDERHOLE") = 1) OR
       (pos (zeile, "BIS")        = 1) OR
       (pos (zeile, "WENN")       = 1)
     THEN fehler (21)
  ELIF (zeile = "Stoptastegedrückt:") OR
       (zeile = "nichtStoptastegedrückt:") OR
       (zeile = "Stoptastegedrueckt:") OR
       (zeile = "nichtStoptastegedrueckt:")
     THEN fehler (22)
     ELSE refinement muss folgen := FALSE;


          line (ziel);
          trage befehlsdefinition ein
  FI.
trage befehlsdefinition ein:
   change (zeile, ":", "");
   FOR index FROM 1 UPTO anzahl refinements REP
     IF refinement [index].name = zeile
        THEN pruefe aufruf; LEAVE trage befehlsdefinition ein
     FI
   PER;
   anzahl refinements INCR 1;
   IF anzahl refinements > max refinements
      THEN fehler (24)
   ELSE refinement [anzahl refinements].name := zeile;
        refinement [anzahl refinements].aufruf := - zeilennummer;


        letztes refinement := anzahl refinements;
        line (ziel);
        put (ziel, "PROC refinement " + text (anzahl refinements) + ":")
   FI.
pruefe aufruf:
  IF refinement [index].aufruf > 0
     THEN refinement [index].aufruf := 0;
          line (ziel);
          put (ziel, "PROC refinement " + text (index) + ":");
          letztes refinement := index
     ELSE fehler (23)
  FI.
pruefe zunaechst auf schluesselworte:
  IF   pos (zeile, "WIEDERHOLE") = 1
       THEN oeffne schleife; LEAVE analysiere und uebersetze


  ELIF pos (zeile, "WENN") = 1
       THEN oeffne if; LEAVE analysiere und uebersetze
  ELIF pos (zeile, "BIS")  = 1
       THEN schliesse mit until; LEAVE analysiere und uebersetze
  ELIF pos (zeile, "ENDE") = 1
       THEN schliesse; LEAVE analysiere und uebersetze
  ELIF pos (zeile, "PROGRAMM") = 1
       THEN fehler (18); LEAVE analysiere und uebersetze
  FI.
oeffne schleife:
  IF letzte geoeffnete = max offene strukturen
     THEN fehler (2)
     ELSE letzte geoeffnete INCR 1;
          offene struktur [letzte geoeffnete] := schleife;


          analysiere schleifenart
  FI.
analysiere schleifenart:
  IF zeile = "WIEDERHOLE"
     THEN line (ziel); put (ziel, "REPEAT")
     ELSE es muss eine zaehlschleife sein
  FI.
es muss eine zaehlschleife sein:
  restzeile := subtext (zeile, 11);
  INT  VAR malpos := pos (restzeile, "MAL");
  IF malpos > 0
     THEN zaehlschleife
     ELSE fehler (3)
  FI.
zaehlschleife:
  IF length (restzeile) > malpos + 2
     THEN fehler (4)
     ELSE bestimme anzahl der wiederholungen
  FI.


bestimme anzahl der wiederholungen:
  INT VAR wdh := int (subtext (restzeile, 1, malpos - 1));
  IF last conversion ok
     THEN line (ziel);
          put (ziel, "INT VAR index" + text (zeilennummer) +
                     "; FOR index" + text (zeilennummer) +
                     " FROM 1 UPTO " + text (wdh) + " REPEAT")
     ELSE fehler (5)
  FI.
oeffne if:
  IF letzte geoeffnete = max offene strukturen
     THEN fehler (6)
     ELSE letzte geoeffnete INCR 1;
          offene struktur [letzte geoeffnete] := abfrage;


          uebersetze abfrage
  FI.
uebersetze abfrage:
  restzeile := subtext (zeile, 5);
  IF   (restzeile = "Stoptastegedrückt") OR
       (restzeile = "Stoptastegedrueckt")
       THEN line (ziel); put (ziel, "IF stoptaste gedrueckt THEN")
  ELIF (restzeile = "nichtStoptastegedrückt") OR
       (restzeile = "nichtStoptastegedrueckt")
       THEN line (ziel); put (ziel, "IF NOT stoptaste gedrueckt THEN")
  ELIF restzeile = ""
       THEN fehler (7)
       ELSE fehler (8)
  FI.
schliesse mit until:


  teste ob als letztes schleife offen;
  letzte geoeffnete DECR 1;
  restzeile := subtext (zeile, 4);
  IF   (restzeile = "Stoptastegedrückt") OR
       (restzeile = "Stoptastegedrueckt")
       THEN line (ziel);
            put (ziel, "UNTIL stoptaste gedrueckt END REPEAT;");
  ELIF (restzeile = "nichtStoptastegedrückt") OR
       (restzeile = "nichtStoptastegedrueckt")
       THEN line (ziel);
            put (ziel, "UNTIL NOT stoptaste gedrueckt END REPEAT;");
  ELIF restzeile = ""


       THEN fehler (9)
       ELSE fehler (8)
  FI.
schliesse:
  restzeile := subtext (zeile, 5);
  IF restzeile = "WIEDERHOLE"
     THEN schliesse schleife
  ELIF restzeile = "WENN"
     THEN schliesse if
  ELIF restzeile = "PROGRAMM"
     THEN programmende
     ELSE fehler (10)
  FI.
schliesse schleife:
  teste ob als letztes schleife offen;
  letzte geoeffnete DECR 1;
  line (ziel); put (ziel, "END REPEAT;").
teste ob als letztes schleife offen:
  IF letzte geoeffnete = 0
     THEN fehler (11);


          LEAVE bearbeite zeile
  ELIF offene struktur [letzte geoeffnete] = abfrage
     THEN fehler (12)
  FI.
schliesse if:
  teste ob als letztes abfrage offen;
  line (ziel); put (ziel, "END IF;");
  letzte geoeffnete DECR 1.
teste ob als letztes abfrage offen:
  IF letzte geoeffnete = 0
     THEN fehler (13);
          LEAVE bearbeite zeile
  ELIF offene struktur [letzte geoeffnete] = schleife
     THEN fehler (14)
  FI.
programmende:
  IF programmende fehlt
     THEN programmende fehlt     := FALSE;


          refinement muss folgen := TRUE
     ELSE fehler (17);
          LEAVE programmende
  FI;
  pruefe auf offene schleife oder abfrage.
pruefe auf offene schleife oder abfrage:
  IF letzte geoeffnete = 0
     THEN alles okay
  ELIF offene struktur [letzte geoeffnete] = schleife
     THEN fehler (14)
     ELSE fehler (12)
  FI.
  alles okay: .
durchsuche befehlsliste:
  IF pos (zeile, ":") > 0
     THEN auf refinementdefinition pruefen
     ELSE befehl suchen
  FI.
befehl suchen:


  BOOL VAR gefunden := FALSE;
  INT VAR i;
  verhindere bedingung;
  FOR i FROM 1 UPTO befehlsanzahl REP
    IF befehl [i].grin = zeile
       THEN gefunden := TRUE;
            line (ziel);
            put (ziel, befehl [i].elan + ";")
    FI
  UNTIL gefunden PER;
  IF NOT gefunden
     THEN trage in refinementliste ein
  FI.
auf refinementdefinition pruefen:
  IF pos (zeile, ":") < length (zeile)
     THEN fehler (20)
  ELIF programmende fehlt
     THEN fehler (16)
  ELIF (zeile = "Stoptastegedrückt:") OR


       (zeile = "nichtStoptastegedrückt:") OR
       (zeile = "Stoptastegedrueckt:") OR
       (zeile = "nichtStoptastegedrueckt:")
     THEN fehler (22)
     ELSE pruefe auf offene schleife oder abfrage;
          put (ziel, "END PROC refinement " + text (letztes refinement)
                                             + ";");
          trage befehlsdefinition ein
  FI.
trage in refinementliste ein:
  FOR index FROM 1 UPTO anzahl refinements REP
    IF refinement [index].name = zeile


       THEN trage evtl aufruf ein;
            LEAVE trage in refinementliste ein
    FI
  PER;
  anzahl refinements INCR 1;
  IF anzahl refinements > max refinements
     THEN fehler (24)
     ELSE refinement [anzahl refinements].name := zeile;
          refinement [anzahl refinements].aufruf := zeilennummer;
          line (ziel);
          put (ziel, "refinement " + text (anzahl refinements) + ";")
  FI.
trage evtl aufruf ein:
  line (ziel);
  put (ziel, "refinement " + text (index) + ";");


  IF refinement [index].aufruf < 0
     THEN refinement [index].aufruf := 0
  FI.
verhindere bedingung:
  IF (zeile = "Stoptastegedrückt") OR (zeile = "nichtStoptastegedrückt") OR
     (zeile = "Stoptastegedrueckt") OR (zeile = "nichtStoptastegedrueckt")
     THEN fehler (15);
          LEAVE bearbeite zeile
  FI.
END PROC uebersetze;
PROC fehler (INT CONST fehlernr):
  noteline;
  note ("FEHLER in Zeile " + text (zeilennummer) + ": ");
  noteline;
  note ("       " + anwendungstext (fehlernr + 20));


  noteline;
  IF erster fehler = 0
     THEN erster fehler := zeilennummer
  FI
END PROC fehler
END PACKET ls warenhaus 4