summaryrefslogtreecommitdiff
path: root/app/gs.warenhaus/1.01/src/ls-Warenhaus 4
blob: a19a6d66945d765488210038452d03d7261317f4 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
(* 
        
         ********************************************************** 
         ********************************************************** 
         **                                                      ** 
         **                    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{}{}