diff options
Diffstat (limited to 'warenhaus/ls-Warenhaus 4')
| -rw-r--r-- | warenhaus/ls-Warenhaus 4 | 421 |
1 files changed, 0 insertions, 421 deletions
diff --git a/warenhaus/ls-Warenhaus 4 b/warenhaus/ls-Warenhaus 4 deleted file mode 100644 index e90e60a..0000000 --- a/warenhaus/ls-Warenhaus 4 +++ /dev/null @@ -1,421 +0,0 @@ -(* - - ********************************************************** - ********************************************************** - ** ** - ** 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 - - - |