PACKET d a t e i e d i t o r paket DEFINES (* Autor: P.Heyderhoff *) (*******************) (* Stand: 19.02.82 *) (* Vers.: 1.6.0 *) define escape , dateieditor : LET satzmax = 4075, dateianker = 2, left = ""8"", escape = ""27"", hop = ""1"", right = ""2"", hoechstes steuerzeichen = ""31"", clear = ""1""4"", hop and mark = ""1""15"", code f = "f", clear line mark = ""5""14"", bell = ""7"", freianker = 1, down = ""10"", begin mark = ""15"", end mark = ""14"", escape escape = ""27""27"", clear eol and mark = ""5""15""; LET DATEI = ROW satzmax STRUCT (INT nachfolger, vorgaenger, index, fortsetzung, TEXT inhalt); FOR j FROM 1 UPTO 127 REP escapefkt (j) := "" PER; INT VAR j, haltzeile :: satzmax, symboltyp, typ, zahlwert, stelle, satz, marke, maxbildlaenge :: 23; FILE VAR sekundaerfile ; TEXT VAR zeichen :: "", ersatz :: "", kommando :: "", symbol :: "", textwert :: "", lernsequenz::""; BOOL VAR war fehler, boolwert; LET op1namen = ";+;-;BEGIN;COL;GET;HALT;LIMIT;MARK;PUT;IF;NOT;REPEAT;WRITE;SIZE"; LET b = 5, c = 11, g = 15, h = 19, l = 24, m = 30, p = 35, i = 39, n = 42, r = 46, w = 53, s=59; LET op2namen = "&+&-&*&/&;&CHANGETO;&OR"; LET plus = 1, minus = 3, mal = 5, durch = 7, semicolon = 9, changecode = 11, or = 21; LET proznamen = ";col;row;halt;limit;mark;len;eof;"; LET pcol = 1, prow = 5, phalt = 9, plimit = 14, pmark = 20, plen = 25, peof = 29; LET void = 0, (* keine angabe des typs *) tag = 1, (* typ: lower case letter *) bold = 2, (* typ: upper case letter *) integer = 3, (* typ: digit *) texttyp = 4, (* typ: quote *) operator = 5, (* typ: operator +-*=<> ** := *) delimiter = 6, (* typ: delimiter ( ) , ; . *) eol = 7, (* typ: niltext, Zeilenende *) bool = 8; (* typ: boolean *) LET varimax = 10; INT VAR freivar :: 1; ROW varimax INT VAR varzahlwert, vartyp; ROW varimax TEXT VAR vartextwert, varname; FOR j FROM 1 UPTO varimax REP vartextwert (j) := ""; varname (j) := "" PER; ROW 127 TEXT VAR escapefkt; (************************* d a t e i e d i t o r *************************) PROC dateieditor (DATEI VAR datei) : INTERNAL 295 ; REP datei editieren UNTIL (feldkommando SUB 1) <> escape PER . datei editieren : war fehler := FALSE ; zeichen := feldkommando SUB 2; IF zeichen = "q" OR zeichen = "w" THEN LEAVE dateieditor ELIF zeichen = escape THEN kommando ermitteln ELSE tastenkommando ermitteln ; (* Li 19.1.82 *) abbruchtest; feldkommando (subtext (feldkommando, 3)) FI; a u s f u e h r e n . tastenkommando ermitteln : IF zeichen > ""0"" AND zeichen < ""128"" THEN kommando := escapefkt (code (zeichen)) (* Li 06.01.82 *) ELSE kommando := "" FI . abbruchtest : IF is incharety (escape) THEN fehler bearbeiten FI . kommando ermitteln : IF (feldkommando SUB 1) = hop THEN lernsequenz auf taste legen; feldkommando (subtext (feldkommando, 4)); LEAVE datei editieren FI; feldkommando (subtext (feldkommando, 3)); kommando := ""; dialog; analysieren . dialog: REP kommandodialog; IF (feldzeichen SUB 1) <> escape OR kommando <> "?" THEN LEAVE dialog ELIF (feldzeichen SUB 2) > ""0"" THEN (* Li 19.02.82 *) kommando := escapefkt (code (feldzeichen SUB 2) MOD 128 ) ELSE kommando := "" FI PER . lernsequenz auf taste legen : lernsequenz := feldaudit; lernsequenz := subtext (lernsequenz, 1, LENGTH lernsequenz - 3); INT CONST lerncode := code (feldkommando SUB 3) MOD 128 ; escapefkt (lerncode) := "W""" ; escapefkt (lerncode) CAT lernsequenz ; (* Li 5.1.81 *) escapefkt (lerncode) CAT """" . kommandodialog : INT CONST feldlaenge :: max (feldende-feldanfang-21, 6) ; cursor (feldrand+1, bildrand+bildzeile+1); out (begin mark, "gib editor kommando: "); feldlaenge TIMESOUT "."; out(end mark); bildneu (TRUE); cursor (feldrand+23, bildrand+bildzeile+1); feldseparator (escape); editget (kommando, 255, feldlaenge); feldseparator ("") . analysieren : IF (feldzeichen SUB 1) = escape AND (feldzeichen SUB 2) > ""0"" (*02.82*) THEN escapefkt (code (feldzeichen SUB 2) MOD 128) := kommando; (* Li 5.1.*) LEAVE datei editieren ELIF kommando = "" THEN LEAVE datei editieren ELIF (kommando SUB 1) = "?" THEN kommandos erklaeren; LEAVE datei editieren ELIF pos ("quit", kommando) = 1 THEN feldkommando (escape escape); LEAVE dateieditor ELSE escapefkt (code (code f)) := kommando FI . ausfuehren : haltzeile := satzmax; IF kommando = "" THEN zeile unveraendert ELSE scan (kommando); nextsymbol; IF a u s d r u c k (datei) THEN IF symboltyp <> eol THEN fehler bearbeiten FI FI; IF war fehler THEN inchar (zeichen) (* warten *) FI FI . kommandos erklaeren : out (clear); putline ("kommandos fuer den benutzer :"); line; putline ("quit : beendet das editieren"); putline (" n : positioniert auf zeile n"); putline ("+ n : blaettert n zeilen vorwaerts"); putline ("- n : blaettert n zeilen rueckwaerts"); putline (" ""z"" : sucht angegebene zeichenkette "); putline ("""muster"" CHANGETO ""ersatz"" :"); putline (" muster wird durch ersatz ersetzt"); putline ("HALT n : sieht anhalten des suchens in zeile n vor"); putline ("GET ""d"" : kopiert datei d und markiert"); putline ("PUT ""d"" : schreibt markierten abschnitt in datei d"); putline ("LIMIT n : setzt schreibende auf spalte n"); putline ("BEGIN n : setzt feldanfang auf spalte n"); putline ("SIZE n : setzt bildlaenge auf n"); line; putline ("?ESCx : zeigt kommando auf escapetaste x"); inchar (zeichen) . END PROC dateieditor; PROC define escape (TEXT CONST cmd char, kommando) : escapefkt (code (cmd char) MOD 128) := kommando END PROC define escape ; (******************** h i l f s - p r o z e d u r e n ********************) PROC fehler bearbeiten : IF NOT war fehler THEN war fehler := TRUE; bildneu (TRUE); out (""2""2""2" kommandofehler bei ",symbol," erkannt."); out (clear line mark) FI END PROC fehler bearbeiten; BOOL PROC fehler : fehler bearbeiten; FALSE END PROC fehler; BOOL PROC klammerzu : IF symbol = ")" THEN nextsymbol; TRUE ELSE fehler FI END PROC klammerzu; PROC nextsymbol : nextsymbol (symbol, symboltyp); IF symboltyp = eol THEN symbol := "kommandoende" FI END PROC nextsymbol; PROC eof (DATEI VAR datei) : boolwert := (bildstelle = dateianker); typ := void END PROC eof; PROC nachsatz (DATEI CONST datei) : stelle := datei (stelle).nachfolger; satz INCR 1; protokoll END PROC nachsatz; PROC vorsatz (DATEI CONST datei) : stelle := datei (stelle).vorgaenger; satz DECR 1; protokoll END PROC vorsatz; PROC protokoll : cout (satz) ; IF is incharety (escape) THEN fehler bearbeiten FI . END PROC protokoll; (******************* s p r i n g e n und s u c h e n *******************) PROC row (DATEI VAR datei) : IF ziel voraus THEN vorwaerts springen ELSE rueckwaerts springen FI; bildsatz (satz); bildstelle (stelle); typ := void; bildneu (TRUE) . ziel voraus : satz := bildsatz; stelle := bildstelle; IF zahlwert > satz THEN TRUE ELIF zahlwert <= satz DIV 2 AND bildmarke = 0 THEN stelle := datei (dateianker).nachfolger; satz := 1; TRUE ELSE FALSE FI . vorwaerts springen : IF zahlwert <= 0 THEN fehler bearbeiten FI ; WHILE stelle <> dateianker AND satz < zahlwert REP nachsatz (datei) UNTIL war fehler PER; IF stelle = dateianker AND satz > 1 THEN vorsatz (datei); feldstelle (LENGTH (datei (stelle).inhalt)+1) FI . rueckwaerts springen : WHILE stelle <> bildmarke AND satz > zahlwert REP vorsatz (datei) UNTIL war fehler PER . END PROC row; PROC search (DATEI VAR datei) : stelle := bildstelle; IF textwert <> "" THEN contextadressierung FI; typ := void . contextadressierung : j := feldstelle - 1; satz := bildsatz; WHILE noch nicht gefunden REP nachsatz (datei) UNTIL war fehler PER; IF stelle = dateianker THEN vorsatz (datei); feldstelle (LENGTH (datei (stelle).inhalt)+1) ELIF j > 0 THEN feldstelle ((LENGTH textwert)+j) FI; IF bildstelle <> stelle THEN bildstelle (stelle); bildsatz (satz); bildneu (TRUE) FI . noch nicht gefunden : j := pos (datei (stelle).inhalt, textwert, j+1); j = 0 AND stelle <> dateianker AND satz < haltzeile . END PROC search; (******************** vom file holen, in file bringen ********************) PROC vom file holen (DATEI VAR datei, TEXT VAR textwert) : stelle := bildstelle; satz := bildsatz; IF datei eroeffnung korrekt THEN IF stelle = dateianker THEN satz erzeugen (datei, stelle) FI; zeile auftrennen; file kopieren; kopiertes markieren; bildstelle (stelle); bildsatz (satz); bildmarke (marke) FI ; textwert := "" . datei eroeffnung korrekt : IF textwert = "" THEN sekundaerfile := sequential file (input); NOT eof (sekundaerfile) ELIF exists (textwert) THEN sekundaerfile := sequential file (input, textwert); NOT eof (sekundaerfile) ELSE FALSE FI . file kopieren : INT VAR altstelle; FOR j FROM 0 UPTO satzmax WHILE NOT eof (sekundaerfile) REP nachsatz (datei); altstelle := stelle; satz erzeugen (datei, stelle); IF stelle = altstelle THEN LEAVE file kopieren FI; getline (sekundaerfile, inhalt) UNTIL war fehler PER . zeile auftrennen : marke := stelle; bildmarksatz (satz); nachsatz (datei); satz erzeugen (datei, stelle); inhalt := subtext (datei (marke).inhalt, feldstelle); vorsatz (datei); inhalt := text (inhalt, feldstelle-1) . kopiertes markieren : nachsatz (datei); IF inhalt = "" THEN satz loeschen (datei, stelle) FI; vorsatz (datei); IF datei (marke).inhalt = "" THEN satz loeschen (datei, marke); satz DECR 1; ELSE marke := datei (marke).nachfolger; bildmarksatz (bildmarksatz+1) FI; feldmarke (feldanfang); feldanfangsmarke (feldanfang); feldstelle (1+LENGTH inhalt); bildneu (TRUE) . inhalt : datei (stelle).inhalt . END PROC vom file holen; PROC in file bringen ( DATEI VAR datei, TEXT VAR textwert) : neuen sekundaerfile erzeugen; marke := bildstelle; stelle := bildmarke; satz := bildmarksatz; IF stelle = marke THEN IF feldmarke <> feldstelle THEN putline (sekundaerfile, subtext (inhalt, feldmarke, feldstelle-1)) FI ELSE IF feldanfangsmarke <= LENGTH inhalt THEN putline (sekundaerfile, subtext (inhalt, feldanfangsmarke)) FI; schreiben; IF feldstelle > feldanfang THEN putline (sekundaerfile, subtext (inhalt, 1, feldstelle-1)) FI FI . schreiben: REP nachsatz (datei); IF stelle = marke OR war fehler THEN LEAVE schreiben FI; putline (sekundaerfile, inhalt) PER . neuen sekundaerfile erzeugen : IF textwert = "" THEN sekundaerfile := sequential file (output) ; ELSE IF exists (textwert) THEN forget (textwert) FI; IF exists (textwert) THEN LEAVE in file bringen FI; sekundaerfile := sequential file (output, textwert) FI . inhalt : datei (stelle).inhalt . END PROC in file bringen; (************************* i n t e r p r e t e r *************************) BOOL PROC primary (DATEI VAR datei) : SELECT symboltyp OF CASE integer : IF LENGTH symbol <= 4 (* Li 20.01.82 *) THEN zahlwert := int (symbol); typ := symboltyp; nextsymbol; TRUE ELSE fehler FI CASE texttyp : textwert := symbol; typ := symboltyp; nextsymbol; TRUE CASE delimiter : IF symbol = "(" THEN nextsymbol; IF ausdruck (datei) THEN klammerzu ELSE fehler FI ELSE fehler FI CASE tag : INT CONST pcode :: pos (proznamen, ";" + symbol + ";"); IF pcode = 0 THEN is variable ELSE nextsymbol; prozedurieren FI CASE bold, operator : INT CONST op1code :: pos (op1namen, ";" + symbol); IF op1code = 0 THEN fehler ELIF op1code = r (* Li 12.01.81 *) THEN wiederholung (datei) ELSE nextsymbol ; IF primary (datei) THEN operieren ELSE fehler FI FI OTHERWISE : fehler END SELECT . is variable : INT VAR var :: 1; WHILE varname (var) <> symbol AND var <> freivar REP var INCR 1 PER; IF var = freivar THEN varname (var) := symbol; nextsymbol; IF symbol = ":=" THEN deklarieren ELSE LEAVE is variable WITH fehler FI ELSE nextsymbol FI; IF symbol = ":=" THEN nextsymbol; assignieren ELSE dereferenzieren FI . dereferenzieren : typ := vartyp (var); zahlwert := varzahlwert (var); textwert := vartextwert (var); TRUE . assignieren : IF primary (datei) THEN IF typ = integer THEN varzahlwert (var) := zahlwert ELIF typ = texttyp THEN vartextwert (var) := textwert ELSE fehler bearbeiten FI; vartyp (var) := typ; typ := void ELSE fehler bearbeiten FI; NOT war fehler . deklarieren : IF freivar = varimax THEN fehler bearbeiten ELSE freivar INCR 1 FI . prozedurieren : typ := integer; SELECT pcode OF CASE pcol : zahlwert := feldstelle CASE plen : zahlwert := LENGTH (datei (bildstelle).inhalt) CASE prow : zahlwert := bildsatz CASE phalt : zahlwert := haltzeile CASE plimit : zahlwert := feldlimit CASE pmark : zahlwert := bildmarke CASE peof : eof (datei) OTHERWISE fehler bearbeiten END SELECT; NOT war fehler . operieren : SELECT op1code OF CASE plus : zahlwert INCR bildsatz; row (datei) CASE minus : zahlwert := bildsatz - zahlwert; row (datei) CASE b : begin CASE c : col CASE g : get CASE h : halt CASE l : limit CASE m : mark CASE p : put CASE i : if CASE w : write CASE s : size OTHERWISE fehler bearbeiten END SELECT; typ := void; TRUE . begin : zahlwert := zahlwert MOD 180; feldende (feldende+zahlwert-feldanfang); feldanfang (zahlwert) . col : zahlwert := zahlwert MOD 256; feldstelle (zahlwert) . get : IF bildmarke <= 0 AND schreiberlaubnis THEN vom file holen (datei, textwert) FI . halt : haltzeile := zahlwert . limit : zahlwert := zahlwert MOD 256; feldlimit (zahlwert) . mark : IF zahlwert = 0 THEN bildmarke (0); feldmarke (0); bildneu (TRUE) ELSE bildmarke (bildstelle); feldmarke (feldstelle); bildmarksatz (bildsatz) FI . put : IF bildmarke > 0 THEN in file bringen (datei, textwert) FI . if : IF bedingung (datei) THEN IF boolwert THEN IF pos ("THEN", symbol) = 1 THEN nextsymbol; IF ausdruck (datei) THEN skip elseteil ELSE fehler bearbeiten FI ELSE fehler bearbeiten FI ELSE skip thenteil; IF j = 1 THEN elseteil ELIF j <> 5 THEN fehler bearbeiten FI FI ELSE fehler bearbeiten FI . elseteil : IF ausdruck (datei) THEN IF symbol = "FI" THEN nextsymbol ELSE fehler bearbeiten FI FI . skip elseteil : WHILE symboltyp <> eol AND pos ("FI", symbol) <> 1 REP nextsymbol PER; nextsymbol . skip thenteil : WHILE (symboltyp <> eol) AND nicht elsefi REP nextsymbol PER; nextsymbol . nicht elsefi : j := pos ("ELSEFI", symbol); j = 0 . write : feldkommando (textwert); zeile unveraendert . size : IF bildlaenge > maxbildlaenge THEN maxbildlaenge := bildlaenge FI; bildlaenge (max (1, min (zahlwert, maxbildlaenge))); bildzeile (min (bildzeile, bildlaenge)); bildrand (0); bildneu (TRUE); page . END PROC primary; (*********** w i e d e r h o l u n g , b e d i n g u n g ***************) BOOL PROC wiederholung (DATEI VAR datei) : fix scanner ; (* Li 12.01.81 *) wiederholt interpretieren; skip endrep; typ := void; NOT war fehler . wiederholt interpretieren : REP reset scanner; nextsymbol; (* 12.01.81 *) WHILE ausdruck (datei) REP UNTIL until PER; abbruchtest UNTIL ende der wiederholung PER . until : IF pos ("UNTIL", symbol) = 1 THEN nextsymbol; IF primary (datei) THEN FI; IF bedingung (datei) THEN IF boolwert THEN LEAVE wiederholt interpretieren;TRUE ELSE TRUE FI ELSE fehler FI ELSE TRUE FI . ende der wiederholung : IF war fehler THEN TRUE ELIF datei (stelle).nachfolger = dateianker THEN feldstelle > LENGTH (datei (stelle).inhalt) ELSE FALSE FI . skip endrep : WHILE pos ("ENDREPEAT", symbol) <> 1 AND symboltyp <> eol REP nextsymbol PER; nextsymbol . abbruchtest : IF is incharety (escape) THEN fehler bearbeiten FI . END PROC wiederholung; BOOL PROC bedingung (DATEI VAR datei) : INT VAR relator; relator := pos ("=><<=>=<>", symbol); IF relator = 0 THEN fehler ELSE IF typ = texttyp THEN relator INCR 8 FI; nextsymbol; INT VAR operandtyp :: typ, operandzahlwert :: zahlwert; TEXT VAR operandtextwert :: textwert; IF primary (datei) THEN FI; IF operandtyp <> typ THEN fehler ELSE boolwert := vergleich; typ := bool; TRUE FI FI . vergleich : SELECT relator OF CASE 1 : operandzahlwert = zahlwert CASE 2 : operandzahlwert > zahlwert CASE 3 : operandzahlwert < zahlwert CASE 4 : operandzahlwert <= zahlwert CASE 6 : operandzahlwert >= zahlwert CASE 8 : operandzahlwert <> zahlwert CASE 9 : operandtextwert = textwert CASE 10 : operandtextwert > textwert CASE 11 : operandtextwert < textwert CASE 12 : operandtextwert <= textwert CASE 14 : operandtextwert >= textwert CASE 16 : operandtextwert <> textwert OTHERWISE fehler END SELECT . END PROC bedingung; (**************************** a u s d r u c k ****************************) BOOL PROC ausdruck (DATEI VAR datei) : INT VAR opcode, operandtyp, operandzahlwert; TEXT VAR operandtextwert; IF primary (datei) THEN BOOL VAR war operation :: TRUE; WHILE operator AND war operation REP IF primary (datei) THEN war operation := operator verarbeiten ELSE war operation := FALSE FI PER; war operation ELSE fehler FI . operator : IF kommandoende THEN IF typ = integer THEN row (datei) ELIF typ = texttyp THEN search (datei) FI FI; opcode := pos (op2namen, "&" + symbol); IF opcode = 0 THEN FALSE ELSE nextsymbol; operandtyp := typ; operandzahlwert := zahlwert; operandtextwert := textwert; NOT war fehler FI . operator verarbeiten : SELECT opcode OF CASE plus : IF typ = integer THEN zahlwert := operandzahlwert + zahlwert ELSE textwert := operandtextwert + textwert FI CASE minus : zahlwert := operandzahlwert - zahlwert CASE mal : IF typ = integer THEN zahlwert := operandzahlwert * zahlwert ELSE textwert := operandzahlwert * textwert FI CASE durch : zahlwert := operandzahlwert DIV zahlwert CASE changecode : change CASE semicolon : OTHERWISE fehler bearbeiten END SELECT; NOT war fehler . change : IF bildmarke <= 0 AND schreiberlaubnis AND bildstelle <> dateianker THEN ersatz := textwert; textwert := operandtextwert; search (datei); INT VAR fstelle :: feldstelle; IF textwert = "" AND ersatz <> "" AND fstelle > LENGTH inhalt THEN inhalt := text (inhalt, fstelle-1) FI; IF subtext (inhalt, fstelle-LENGTH textwert, fstelle-1) = textwert THEN fstelle := fstelle - LENGTH textwert; FOR j FROM 1 UPTO LENGTH ersatz REP IF j <= LENGTH textwert THEN replace (inhalt, fstelle, ersatz SUB j) ELSE insert char (inhalt, ersatz SUB j, fstelle) FI; fstelle INCR 1 PER; FOR j FROM 1+LENGTH ersatz UPTO LENGTH textwert REP delete char (inhalt, fstelle) PER; FI; feldstelle (fstelle); typ := void ELSE fehler bearbeiten FI . inhalt : datei (stelle).inhalt . kommandoende : SELECT pos (";FIELSEENDREPEATUNTIL", symbol) OF CASE 1,2,4,8,17 : TRUE OTHERWISE symboltyp = eol END SELECT . END PROC ausdruck; (************************** schrott ****************************************) PROC satz erzeugen (DATEI VAR datei, INT VAR satz): EXTERNAL 291 ; END PROC satz erzeugen; PROC satz loeschen (DATEI VAR datei, INT VAR satz): EXTERNAL 292 ; END PROC satz loeschen; END PACKET dateieditorpaket;