diff options
Diffstat (limited to 'system/base/1.7.5/src/file')
| -rw-r--r-- | system/base/1.7.5/src/file | 2122 |
1 files changed, 2122 insertions, 0 deletions
diff --git a/system/base/1.7.5/src/file b/system/base/1.7.5/src/file new file mode 100644 index 0000000..530dcb3 --- /dev/null +++ b/system/base/1.7.5/src/file @@ -0,0 +1,2122 @@ +(* ------------------- VERSION 35 02.06.86 ------------------- *) +PACKET file handling DEFINES (* Autoren: J.Liedtke, D.Martinek *) + (***********) + + FILE, + :=, + sequential file, + reorganize, + input, + output, + modify, + close, + putline, + getline, + put, + get, + write , + line, + reset, + down, + up, + downety, + uppety, + pattern found, + to first record, + to line, + to eof, + insert record, + delete record, + read record, + write record, + is first record, + eof, + line no, + FRANGE, + set range, + reset range , + remove, + clear removed, + reinsert, + max line length, + edit info, + line type , + copy attributes , + headline, + put tabs, + get tabs, + col, + word, + at, + removed lines, + exec, + pos , + len , + subtext , + change , + lines , + segments , + mark , + mark line no , + mark col , + set marked range , + split line , + concatenate line , + prefix , + sort , + lexsort : + + +(**********************************************************************) +(* *) +(* Terminologie: *) +(* *) +(* *) +(* ATOMROW Menge aller Atome eines FILEs. *) +(* Die einzelnen Atome haben zwar eine Position *) +(* im Row, aber in dieser Betrachtung keine *) +(* logische Reihenfolge. *) +(* *) +(* ATOM Basiselement, kann eine Zeile der Datei und die *) +(* zugehoerige Verwaltungsinformation aufnehmen *) +(* *) +(* CHAIN Zyklisch geschlossene Kette von Segmenten. *) +(* *) +(* SEGMENT Teilbereich des Atomrows, enthaelt 1 oder mehr *) +(* zusammenhaengende Atoms. *) +(* Jedes Segment hat ein Vorgaenger- und ein *) +(* Nachfolgersegment. *) +(* Jedes Segment enthaelt einen logisch zumsammen- *) +(* haengenden Teile einer Sequence. *) +(* *) +(* SEQUENCE Logische Folge von Lines. *) +(* Jede Sequence ist Teil einer Chain oder besteht *) +(* vollstaendig daraus: *) +(* *) +(* SEG1--SEG2--SEG3--SEG4--SEG5 *) +(* :----sequence----: *) +(* *) +(* Die 'Reihenfolge' ebenso wie die 'Anzahl' der *) +(* Lines ist eine wesentliche Eigenschaft einer *) +(* Sequence. *) +(* *) +(* LINE Ein Atom als Element ein Sequence betrachtet. *) +(* *) +(* *) +(**********************************************************************) +(* *) +(* Eigenschaften: *) +(* *) +(* Folgende Mengen bilden eine Zerlegung (im math. Sinn) einer *) +(* gesamten Datei: *) +(* used segment chain *) +(* scratch segment chain *) +(* free segment chain *) +(* unused tail *) +(* *) +(* Fuer jedes X aus (used, scratch, free) gelten: *) +(* *) +(* 'X sequence' ist echte Teilmenge von 'X segment chain'. *) +(* *) +(* (Daraus folgt, es gibt keine leere 'chain'.) *) +(* *) +(* 'X segment chain' ist zyklisch gekettet. *) +(* *) +(* Alle Atome von 'X segment chain' haben definierten Inhalt. *) +(* *) +(**********************************************************************) + + +LET file size = 4075 , + nil = 0 , + + free root = 1 , + scratch root = 2 , + used root = 3 , + first unused = 4 ; + + +LET SEQUENCE = STRUCT (INT index, segment begin, segment end, + INT line no, lines), + SEGMENT = STRUCT (INT succ, pred, end), + ATOM = STRUCT (SEGMENT seg, INT type, TEXT line), + ATOMROW = ROW filesize ATOM, + + LIST = STRUCT (SEQUENCE used, INT prefix lines, postfix lines, + SEQUENCE scratch, free, INT unused tail, + INT mode, col, limit, edit info, mark line, mark col, + ATOMROW atoms); + +TYPE FILE = BOUND LIST ; + +TYPE FRANGE = STRUCT (INT pre, post, BOOL pre was split, post was split); + + +OP := (FRANGE VAR left, FRANGE CONST right): + CONCR (left) := CONCR (right) +ENDOP := ; + + +OP := (FILE VAR left, FILE CONST right): + EXTERNAL 260 +END OP :=; + + +PROC becomes (INT VAR a, b) : + INTERNAL 260 ; + a := b +END PROC becomes; + + +PROC initialize (FILE VAR f) : + + f.used := SEQUENCE : (used root, used root, used root, 1, 0); + f.prefix lines := 0; + f.postfix lines := 0; + f.free := SEQUENCE : (free root, free root, free root, 1, 0); + f.scratch := SEQUENCE : (scratch root, scratch root, scratch root, 1, 0); + f.unused tail := first unused; + + f.limit := 77; + f.edit info := 0; + f.col := 1 ; + f.mark line := 0 ; + f.mark col := 0 ; + + INT VAR i; + FOR i FROM 1 UPTO 3 REP + root (i).seg := SEGMENT : (i, i, i); + root (i).line := "" + PER; + put tabs (f, "") . + +root : f.atoms . + +END PROC initialize; + + +(**********************************************************************) +(* *) +(* Segment Handler (SEGMENTs & CHAINs) *) +(* *) +(**********************************************************************) + +INT PROC segs (SEQUENCE CONST s, ATOMROW CONST atom) : + + INT VAR number of segments := 0 , + actual segment := s.segment begin ; + REP + number of segments INCR 1 ; + actual segment := atom (actual segment).seg.succ + UNTIL actual segment = s.segment begin PER ; + number of segments . + +ENDPROC segs ; + + +PROC next segment (SEQUENCE VAR s, ATOMROW CONST atom) : + + disable stop; + s.line no INCR (s.segment end - s.index + 1); + INT CONST new segment index := actual segment.succ; + s.segment begin := new segment index; + s.segment end := new segment.end; + s.index := new segment index . + +actual segment : atom (s.segment begin).seg . +new segment : atom (new segment index).seg . + +END PROC next segment; + + +PROC previous segment (SEQUENCE VAR s, ATOMROW CONST atom) : + + disable stop; + s.line no DECR (s.index - s.segment begin + 1); + INT CONST new segment index := actual segment.pred; + s.segment begin := new segment index; + s.segment end := new segment.end; + s.index := s.segment end . + +actual segment : atom (s.segment begin).seg . +new segment : atom (new segment index).seg . + +END PROC previous segment; + + +PROC split segment (SEQUENCE VAR s, ATOMROW VAR atom) : + + disable stop; + IF not at segment top + THEN split segment at actual position + FI . + +split segment at actual position : + INT CONST pred index := s.segment begin, + actual index := s.index, + succ index := pred.succ; + + actual.pred := pred index; + actual.succ := succ index; + actual.end := s.segment end; + + pred.succ := actual index; + pred.end := actual index - 1; + + succ.pred := actual index; + + s.segment begin := actual index . + +not at segment top : s.index > s.segment begin . + +pred : atom (pred index).seg . + +actual : atom (actual index).seg . + +succ : atom (succ index).seg . + +END PROC split segment; + + +PROC join segments (ATOMROW VAR atom, + INT CONST first index, INT VAR second index) : + + disable stop; + IF first seg.end + 1 = second index + THEN attach second to first segment + ELSE link first to second segment + FI . + +attach second to first segment : + first seg.end := second seg.end; + INT VAR successor of second := second seg.succ; + IF successor of second = second index + THEN first seg.succ := first index + ELSE join segments (atom, first index, successor of second) + FI; + second index := first index . + +link first to second segment : + first seg.succ := second index; + second seg.pred := first index . + +first seg : atom (first index).seg . +second seg : atom (second index).seg . + +END PROC join segments; + + +PROC delete segments (SEQUENCE VAR from, ATOMROW VAR atom, + INT CONST first index, last index, lines) : + + determine surrounding segments and new atom index; + join surrounding segments; + update sequence descriptor . + +determine surrounding segments and new atom index : + INT VAR pred index := first seg.pred, + actual index := last seg.succ; + from.index := actual index . + +join surrounding segments : + join segments (atom, pred index, actual index) . + +update sequence descriptor : + from.segment begin := actual index; + from.segment end := actual seg.end; + from.lines DECR lines . + +actual seg : atom (actual index).seg . +first seg : atom (first index).seg . +last seg : atom (last index).seg . + +END PROC delete segments; + + +PROC insert segments (SEQUENCE VAR into, ATOMROW VAR atom, + INT CONST first index, last index, lines) : + + join into sequence and new segments; + update sequence descriptor . + +join into sequence and new segments : + INT VAR actual index := into.index, + pred index := actual seg.pred; + join segments (atom, last index, actual index); + actual index := first index; + join segments (atom, pred index, actual index) . + +update sequence descriptor : + into.index := first index; + into.segment begin := actual index; + into.segment end := actual seg.end; + into.lines INCR lines . + +actual seg : atom (actual index).seg . + +END PROC insert segments; + + +PROC next atom (SEQUENCE VAR s, ATOMROW CONST atom) : + + IF s.line no <= s.lines + THEN to next atom + ELSE errorstop ("'down' nach Dateiende") + FI . + +to next atom : + disable stop; + IF s.index = s.segment end + THEN next segment (s, atom) + ELSE s.index INCR 1; + s.line no INCR 1 + FI + +END PROC next atom; + + +PROC next atoms (SEQUENCE VAR s, ATOMROW CONST atom, INT CONST times) : + + INT CONST destination line := min (s.line no + times, s.lines + 1); + jump upto destination segment; + position within destination segment . + +jump upto destination segment : + WHILE s.line no + length of actual segments tail < destination line REP + next segment (s, atom); + PER . + +position within destination segment : + disable stop; + s.index INCR (destination line - s.line no); + s.line no := destination line . + +length of actual segments tail : s.segment end - s.index . + +END PROC next atoms; + + +PROC previous atom (SEQUENCE VAR s, ATOMROW CONST atom) : + + IF s.line no > 1 + THEN to previous atom + ELSE errorstop ("'up' am Dateianfang") + FI . + +to previous atom : + disable stop; + IF s.index = s.segment begin + THEN previous segment (s, atom) + ELSE s.index DECR 1; + s.line no DECR 1 + FI + +END PROC previous atom; + + +PROC previous atoms (SEQUENCE VAR s, ATOMROW CONST atom, INT CONST times) : + + INT CONST destination line := max (1, s.line no - times); + jump back to destination segment; + position within destination segment . + +jump back to destination segment : + WHILE s.line no - length of actual segments head > destination line REP + previous segment (s, atom); + PER . + +position within destination segment : + disable stop; + s.index DECR (s.line no - destination line); + s.line no := destination line . + +length of actual segments head : s.index - s.segment begin . + +END PROC previous atoms; + + +TEXT VAR pre, pat, pattern0; +INT VAR last search line ; + +PROC search down (SEQUENCE VAR s, ATOMROW CONST atom, TEXT CONST pattern, + INT CONST max lines, INT VAR column) : + + INT CONST start col := column , + start line := s.lineno ; + last search line := min (s.lines, s.lineno + max lines) ; + pre:= somefix (pattern) ; + pattern0 := pattern ** 0 ; + down in atoms (s, atom, pre, column); + IF NOT (last search succeeded CAND like pattern) + THEN try again + FI; + last search succeeded := TRUE ; + column := matchpos (0) . + +try again: + WHILE s.line no < last search line + REP next atom (s, atom) ; + column := 1 ; + down in atoms (s, atom, pre, column); + IF last search succeeded CAND like pattern + THEN LEAVE try again + FI + PER; + column := 1 + LENGTH record; + last search succeeded := FALSE ; + LEAVE search down. + +like pattern : + correct position ; + pat := any (column-1) ; + pat CAT any ; + pat CAT pattern0 ; + pat CAT any ; + record LIKE pat . + +correct position : + IF s.lineno = start line + THEN column := start col + ELSE column := 1 + FI . + +record : atom (s.index).line . + +ENDPROC search down ; + +PROC down in atoms (SEQUENCE VAR s, ATOMROW CONST atom, TEXT CONST pattern, + INT VAR column) : + + last search succeeded := FALSE ; + search forwards in actual line ; + IF NOT found AND s.line no < last search line + THEN search in following lines + FI ; + IF found + THEN last search succeeded := TRUE + ELSE set column behind last char + FI . + +set column behind last char : + column := LENGTH atom (s.index).line + 1 . + +search forwards in actual line : + IF pattern <> "" + THEN column := pos (atom (s.index).line, pattern, column) + ELIF column > LENGTH atom (s.index).line + THEN column := 0 + FI . + +search in following lines : + next atom (s, atom) ; + IF pattern = "" + THEN column := 1 ; + LEAVE search in following lines + FI ; + REP + search forwards through segment ; + update file position forwards ; + IF found OR s.line no = last search line + THEN LEAVE search in following lines + ELSE next segment (s, atom) + FI + PER . + +search forwards through segment : + INT VAR search index := s.index , + last index := min (s.segment end, s.index+(last search line-s.line no)); + REP + column := pos (atom (search index).line, pattern) ; + IF found OR search index = last index + THEN LEAVE search forwards through segment + FI ; + search index INCR 1 + PER . + +update file position forwards : + disable stop ; + s.line no INCR (search index - s.index) ; + s.index := search index ; + enable stop . + +found : column > 0 . + +ENDPROC down in atoms ; + +TEXT PROC prefix (TEXT CONST pattern) : + + INT VAR invalid char pos := pos (pattern, ""0"", ""31"", 1) ; + SELECT invalid char pos OF + CASE 0 : pattern + CASE 1 : "" + OTHERWISE : subtext (pattern, 1, invalid char pos - 1) + ENDSELECT . + +ENDPROC prefix ; + +PROC search up (SEQUENCE VAR s, ATOMROW CONST atom, TEXT CONST pattern, + INT CONST max lines, INT VAR column) : + + last search line := max (1, s.lineno - max lines) ; + pre:= prefix (pattern); + pattern0 := pattern ** 0; + remember start point ; + up in atoms (s, atom, pre, column); + IF NOT (last search succeeded CAND last pattern in line found) + THEN try again + FI; + last search succeeded := TRUE ; + column := matchpos (0) . + + try again: + WHILE s.lineno > last search line OR column > 1 + REP previous atom (s, atom); + column := LENGTH record ; + up in atoms (s, atom, pre, column); + IF last search succeeded CAND last pattern in line found + THEN LEAVE try again + FI + PER; + column := 1; + last search succeeded := FALSE ; + LEAVE search up. + + remember start point : + INT VAR c:= column, r:= s.lineno;. + + last pattern in line found : + column := 2 ; + WHILE like pattern CAND right of start REP + column := matchpos (0) +1 + PER ; + column DECR 1 ; + like pattern CAND right of start . + + like pattern : + pat := any (column-1) ; + pat CAT any ; + pat CAT pattern0 ; + pat CAT any ; + record LIKE pat . + + right of start : (r > s.lineno COR c >= matchpos(0)) . + record : atom (s.index).line . + +ENDPROC search up ; + +PROC up in atoms (SEQUENCE VAR s, ATOMROW CONST atom, TEXT CONST pattern, + INT VAR column) : + + last search succeeded := FALSE ; + search backwards in actual line ; + IF NOT found AND s.line no > last search line + THEN search in preceeding lines + FI ; + IF found + THEN last search succeeded := TRUE + ELSE column := 1 + FI . + +search backwards in actual line : + IF pattern = "" + THEN LEAVE search backwards in actual line + FI ; + INT VAR last pos , new pos := 0 ; + REP + last pos := new pos ; + new pos := pos (atom (s.index).line, pattern, last pos+1) ; + UNTIL new pos = 0 OR new pos > column PER ; + column := last pos . + +search in preceeding lines : + previous atom (s, atom) ; + IF pattern = "" + THEN column := LENGTH atom (s.index).line + 1 ; + last search succeeded := TRUE ; + LEAVE search in preceeding lines + FI ; + REP + search backwards through segment ; + update file position backwards ; + IF found OR s.line no = last search line + THEN LEAVE search in preceeding lines + ELSE previous segment (s, atom) + FI + PER . + +search backwards through segment : + INT VAR search index := s.index , + last index := max (s.segment begin, s.index-(s.line no-last search line)); + REP + new pos := 0 ; + REP + column := new pos ; + new pos := pos (atom (search index).line, pattern, column+1) ; + UNTIL new pos = 0 PER ; + IF found OR search index = last index + THEN LEAVE search backwards through segment + FI ; + search index DECR 1 + PER . + +update file position backwards : + disable stop ; + s.line no DECR (s.index - search index) ; + s.index := search index ; + enable stop . + +found : column > 0 . + +ENDPROC up in atoms ; + +BOOL VAR last search succeeded ; + +BOOL PROC pattern found : + last search succeeded +ENDPROC pattern found ; + + + +PROC delete atom (SEQUENCE VAR used, free, ATOMROW VAR atom) : + + disable stop; + IF used.line no <= used.lines + THEN delete actual atom + ELSE errorstop ("'delete' am Dateiende") + FI . + +delete actual atom : + position behind actual free segment; + split segment (used, atom); + INT VAR actual index := used.index; + cut off tail of actual used segment; + delete segments (used, atom, actual index, actual index, 1); + insert segments (free, atom, actual index, actual index, 1) . + +position behind actual free segment : + IF free.line no <= free.lines + THEN next segment (free, atom) + FI . + +cut off tail of actual used segment : + IF actual index <> used.segment end + THEN used.index INCR 1; + split segment (used, atom); + used.index DECR 1 + FI . + +END PROC delete atom; + + +PROC insert atom (SEQUENCE VAR used, free,INT VAR unused, ATOMROW VAR atom) : + + disable stop; + split segment (used, atom); + IF free.lines > 0 + THEN insert new atom from free sequence + ELIF unused <= file size + THEN insert new atom from unused tail + ELSE errorstop ("FILE-Ueberlauf") + FI . + +insert new atom from free sequence : + get a free segments head; + make this atom to actual segment; + transfer from free to used chain . + +get a free segments head : + IF actual free segment is root segment + THEN previous segment (free, atom) + FI; + position to actual segments head . + +position to actual segments head : + INT VAR actual index := free.segment begin; + free.line no DECR (free.index - actual index); + free.index := actual index . + +make this atom to actual segment : + IF free.segment end > actual index + THEN free.index INCR 1; + split segment (free, atom); + free.index DECR 1 + FI . + +transfer from free to used chain : + delete segments (free, atom, actual index, actual index, 1); + insert segments (used, atom, actual index, actual index, 1); + atom (actual index).line := "" . + +insert new atom from unused tail : + actual index := unused; + atom (actual index).seg := + SEGMENT:(actual index, actual index, actual index); + atom (actual index).line := ""; + insert segments (used, atom, actual index, actual index, 1); + unused INCR 1 . + +actual free segment is root segment : free.segment begin = free root . + +END PROC insert atom; + + +PROC insert next (SEQUENCE VAR used, free, INT VAR unused, ATOMROW VAR atom, + TEXT CONST record) : + + IF used.line no > used.lines + THEN insert atom (used, free, unused, atom) + ELIF actual position before unused nonempty atomrow part + THEN forward and insert atom by simple extension of used atomrow part + ELSE next atom (used, atom); + insert atom (used, free, unused, atom) + FI; + atom (used.index).line := record . + +forward and insert atom by simple extension of used atomrow part : + used.line no INCR 1; + used.lines INCR 1; + used.index INCR 1; + used.segment end INCR 1; + atom (used.segment begin).seg.end INCR 1; + unused INCR 1 . + +actual position before unused nonempty atomrow part : + used.index = unused - 1 AND unused part not empty . + +unused part not empty : unused <= file size . + +END PROC insert next; + + +PROC transfer subsequence (SEQUENCE VAR source, dest, + ATOMROW VAR atom, INT CONST size) : + + IF size > 0 + THEN INT VAR subsequence size := min (size, source.line no); + mark begin of source part; + mark end of source part; + split destination sequence; + transfer part + FI . + +mark begin of source part : + previous atoms (source, atom, subsequence size - 1); + split segment (source, atom); + INT CONST first := source.segment begin . + +mark end of source part : + next atoms (source, atom, subsequence size - 1); + INT CONST last := source.segment begin; + next atom (source, atom); + split segment (source, atom) . + +split destination sequence : + split segment (dest, atom) . + +transfer part : + disable stop; + delete segments (source, atom, first, last, subsequence size); + source.line no DECR subsequence size; + insert segments (dest, atom, first, last, subsequence size); + next atoms (dest, atom, subsequence size - 1) . + +END PROC transfer subsequence; + + + +(********************************************************************) +(***** *****) +(***** FILE handler *****) +(***** *****) +(********************************************************************) + + + +LET file type = 1003 , + file type 16 = 1002 , + + closed = 0, + inp = 1, + outp = 2, + mod = 3, + end = 4, + + max limit = 16000, + super limit = 16001; + + +TYPE TRANSPUTDIRECTION = INT; + + +TRANSPUTDIRECTION PROC input : + TRANSPUTDIRECTION : (inp) +END PROC input; + + +TRANSPUTDIRECTION PROC output : + TRANSPUTDIRECTION : (outp) +END PROC output; + + +TRANSPUTDIRECTION PROC modify : + TRANSPUTDIRECTION : (mod) +END PROC modify; + + +FILE VAR result file; + + +FILE PROC sequential file (TRANSPUTDIRECTION CONST mode, + DATASPACE CONST ds) : + IF type (ds) = file type + THEN result := ds + ELIF type (ds) < 0 + THEN result := ds; type (ds, file type); initialize (result file) + ELSE enable stop; errorstop ("Datenraum hat falschen Typ") + FI; + reset (result file, mode); + result file . + +result : CONCR (result file) . + +END PROC sequential file; + + +FILE PROC sequential file (TRANSPUTDIRECTION CONST mode, TEXT CONST name) : + + IF exists (name) + THEN get dataspace if file + ELIF CONCR (mode) <> inp + THEN get new file space + ELSE errorstop (""""+name+""" gibt es nicht") ; enable stop + FI; + update status if necessary; + reset (result file, mode); + result file . + +get dataspace if file : + IF type (old (name)) = file type 16 + THEN reorganize (name) + FI ; + result := old (name, file type) ; + IF is 170 file + THEN result.col := 1 ; + result.mark line := 0 ; + result.mark col := 0 + FI . + +is 170 file : result.mark col < 0 . + +get new file space : + result := new (name); + IF NOT is error + THEN type (old (name), file type); initialize (result file) + FI . + +update status if necessary : + IF CONCR (mode) <> inp + THEN status (name, ""); headline (result file, name) + FI . + +result : CONCR (result file) . + +END PROC sequential file; + + +PROC reset (FILE VAR f) : + + IF f.mode = end + THEN reset (f, input) + ELSE reset (f, TRANSPUTDIRECTION:(f.mode)) + FI . + +ENDPROC reset ; + +PROC reset (FILE VAR f, TRANSPUTDIRECTION CONST mode) : + + IF f.mode <> mod OR new mode <> mod + THEN f.mode := new mode ; + initialize file index + FI . + +initialize file index : + IF new mode = outp + THEN to line without check (f, f.used.lines); + col := super limit + ELSE to line without check (f, 1); + col := 1 ; + IF new mode = inp AND file is empty + THEN f.mode := end + FI + FI . + +file is empty : f.used.lines = 0 . + +new mode : CONCR (mode) . + +col : CONCR (CONCR (f)).col . + +END PROC reset; + + +PROC input (FILE VAR f) : + + reset (f, input) . + +END PROC input; + + +PROC output (FILE VAR f) : + + reset (f, output) + +END PROC output; + + +PROC modify (FILE VAR f) : + + reset (f, modify) + +END PROC modify; + + +PROC close (FILE VAR f) : + + f.mode := closed . + +END PROC close; + + +PROC check mode (FILE CONST f, INT CONST mode) : + + IF f.mode = mode + THEN LEAVE check mode + ELIF f.mode = closed + THEN errorstop ("Datei zu!") + ELIF f.mode = mod + THEN errorstop ("unzulaessiger Zugriff auf modify-FILE") + ELIF mode = mod + THEN errorstop ("Zugriff nur auf modify-FILE zulaessig") + ELIF f.mode = end + THEN errorstop ("Leseversuch nach Dateiende") + ELIF mode = inp + THEN errorstop ("Leseversuch auf output-FILE") + ELIF mode = outp + THEN errorstop ("Schreibversuch auf input-FILE") + FI . + +END PROC check mode; + + +PROC to line without check (FILE VAR f, INT CONST destination line) : + + INT CONST distance := destination line - f.used.line no; + IF distance > 0 + THEN next atoms (f.used, f.atoms, distance) + ELIF distance < 0 + THEN previous atoms (f.used, f.atoms, - distance) + FI . + +END PROC to line without check; + + +PROC to line (FILE VAR f, INT CONST destination line) : + + check mode (f, mod); + to line without check (f, destination line) + +END PROC to line; + + +PROC to first record (FILE VAR f) : + + to line (f, 1) + +END PROC to first record; + + +PROC to eof (FILE VAR f) : + + to line (f, f.used.lines + 1) . + +END PROC to eof; + + +PROC putline (FILE VAR f, TEXT CONST word) : + + write (f, word); + col := super limit . + +col : CONCR (CONCR (f)).col . + +END PROC putline; + + +PROC delete record (FILE VAR f) : + + check mode (f, mod); + delete atom (f.used, f.free, f.atoms) . + +END PROC delete record; + + +PROC insert record (FILE VAR f) : + + check mode (f, mod); + insert atom (f.used, f.free, f.unused tail, f.atoms) . + +END PROC insert record; + + +PROC down (FILE VAR f) : + + check mode (f, mod); + next atom (f.used, f.atoms) . + +END PROC down ; + +PROC up (FILE VAR f) : + + check mode (f, mod); + previous atom (f.used, f.atoms) . + +END PROC up ; + +PROC down (FILE VAR f, INT CONST n) : + + to line (f, lineno (f) + n) + +ENDPROC down ; + +PROC up (FILE VAR f, INT CONST n) : + + to line (f, lineno (f) - n) + +ENDPROC up ; + + +PROC write record (FILE VAR f, TEXT CONST record) : + + check mode (f, mod); + IF not at eof + THEN f.atoms (f.used.index).line := record + ELSE errorstop ("'write' nach Dateiende") + FI . + +not at eof : f.used.line no <= f.used.lines . + +END PROC write record; + + +PROC read record (FILE CONST f, TEXT VAR record) : + + check mode (f, mod); + record := f.atoms (f.used.index).line . + +END PROC read record; + + +PROC line (FILE VAR f) : + + IF mode = end + THEN errorstop ("Leseversuch nach Dateiende") + ELIF mode = inp + THEN next atom (f.used, f.atoms); col := 1; check eof + ELIF mode = outp + THEN IF col <= max limit + THEN col := super limit + ELSE append empty line + FI + FI . + +append empty line : + insert next (f.used, f.free, f.unused tail, f.atoms, "") . + +col : CONCR (CONCR (f)).col . + +mode : CONCR (CONCR (f)).mode . + +check eof : + IF eof (f) THEN mode := end FI . + +END PROC line; + + +PROC line (FILE VAR f, INT CONST lines) : + + INT VAR i; FOR i FROM 1 UPTO lines REP line (f) PER + +END PROC line; + + +PROC getline (FILE VAR f, TEXT VAR text) : + + check mode (f, inp); + text := subtext (record, f.col); + IF f.used.line no >= f.used.lines + THEN f.mode := end ; + set end of file + ELSE to next line ; + f.col := 1 + FI . + +to next line : + next atom (f.used, f.atoms) . + +set end of file : + f.col := LENGTH record + 1 . + +record : f.atoms (f.used.index).line . + +END PROC getline; + + +BOOL PROC is first record (FILE CONST f) : + + check mode (f, mod); + f.used.line no = 1 . + +END PROC is first record; + + +BOOL PROC eof (FILE CONST f) : + + IF line no < lines THEN FALSE + ELIF line no = lines THEN col > LENGTH record + ELSE TRUE + FI . + +line no : f.used.line no . +lines : f.used.lines . +col : f.col . +record : f.atoms (f.used.index).line . + +END PROC eof; + + +INT PROC line no (FILE CONST f) : + + f.used.line no . + +END PROC line no; + + +PROC line type (FILE VAR f, INT CONST t) : + + f.atoms (f.used.index).type := t . + +ENDPROC line type ; + +INT PROC line type (FILE CONST f) : + + f.atoms (f.used.index).type . + +ENDPROC line type ; + + +PROC put (FILE VAR f, TEXT CONST word) : + + check mode (f, outp); + IF col + LENGTH word > f.limit + THEN append new line + ELSE record CAT word + FI; + record CAT " "; + col := LENGTH record + 1 . + +append new line : + insert next (f.used, f.free, f.unused tail, f.atoms, word) . + +record : f.atoms (f.used.index).line . +col : f.col . + +END PROC put; + + +PROC put (FILE VAR f, INT CONST value) : + + put (f, text (value)) + +END PROC put; + + +PROC put (FILE VAR f, REAL CONST real) : + + put (f, text (real)) + +END PROC put; + + +PROC write (FILE VAR f, TEXT CONST word) : + + check mode (f, outp); + IF col + LENGTH word - 1 > f.limit + THEN append new line + ELSE record CAT word + FI; + col := LENGTH record + 1 . + +append new line : + insert next (f.used, f.free, f.unused tail, f.atoms, word) . + +record : f.atoms (f.used.index).line . +col : f.col . + +END PROC write; + + +PROC get (FILE VAR f, TEXT VAR word, TEXT CONST separator) : + + check mode (f, inp); + skip separators; + IF word found + THEN get word + ELSE try to find word in next line + FI . + +skip separators : + INT CONST separator length := LENGTH separator; + WHILE is separator REP col INCR separator length PER . + +is separator : + subtext (record, col, col + separator length - 1) = separator . + +word found : col <= LENGTH record . + +get word : + INT VAR end of word := pos (record, separator, col) - 1; + IF separator found + THEN get text upto separator + ELSE get rest of record + FI . + +separator found : end of word >= 0 . + +get text upto separator : + word := subtext (record, col, end of word); + col := end of word + separator length + 1; + IF col > LENGTH record THEN line (f) FI . + +get rest of record : + word := subtext (record, col); line (f) . + +record : f.atoms (f.used.index).line . +col : f.col . + +try to find word in next line : + line (f); IF eof (f) THEN word := "" ELSE get (f, word, separator) FI . + +END PROC get; + + +PROC get (FILE VAR f, TEXT VAR word, INT CONST max length) : + + check mode (f, inp); + IF word is only a part of record + THEN get text of certain length + ELSE get rest of record + FI . + +word is only a part of record : + col <= LENGTH record - max length . + +get text of certain length : + word := text (record, max length, col); + col INCR max length . + +get rest of record : + word := subtext (record, col); line (f) . + +record : f.atoms (f.used.index).line . +col : f.col . + +END PROC get; + + +PROC get (FILE VAR f, TEXT VAR word) : + + get (f, word, " ") + +END PROC get; + + +TEXT VAR number word; + + +PROC get (FILE VAR f, INT VAR number) : + + get (f, number word); + number := int (number word) + +END PROC get; + + +PROC get (FILE VAR f, REAL VAR number) : + + get (f, number word); + number := real (number word) + +END PROC get; + + +TEXT VAR split record ; +INT VAR indentation ; + +PROC split line (FILE VAR f, INT CONST split col) : + + split line (f, split col, TRUE) + +ENDPROC split line ; + +PROC split line (FILE VAR f, INT CONST split col, BOOL CONST note indentation ) : + + IF note indentation + THEN get indentation + ELSE indentation := 0 + FI ; + get split record ; + insert split record and indentation ; + cut off old record . + +get indentation : + indentation := pos (actual record,""33"",""254"",1) - 1 ; + IF indentation < 0 OR indentation >= split col + THEN indentation := split col - 1 + FI . + +get split record : + split record := subtext (actual record, split col, max limit) . + +insert split record and indentation : + down (f) ; + insert record (f) ; + INT VAR i ; + FOR i FROM 1 UPTO indentation REP + actual record CAT " " + PER ; + actual record CAT split record ; + up (f) . + +cut off old record : + actual record := subtext (actual record, 1, split col-1) . + +actual record : f.atoms (f.used.index).line . + +ENDPROC split line ; + +PROC concatenate line (FILE VAR f, BOOL CONST delete blanks) : + + down (f) ; + split record := actual record ; + IF delete blanks + THEN delete leading blanks + FI ; + delete record (f) ; + up (f) ; + actual record CAT split record . + +delete leading blanks : + INT CONST non blank col := pos (split record, ""33"", ""254"", 1) ; + IF non blank col > 0 + THEN split record := subtext (split record, non blank col) + FI . + +actual record : f.atoms (f.used.index).line . + +ENDPROC concatenate line ; + +PROC concatenate line (FILE VAR f) : + concatenate line (f, TRUE) +ENDPROC concatenate line ; + +PROC reorganize : + + reorganize (last param) + +END PROC reorganize; + + +TEXT VAR file record ; + +PROC reorganize (TEXT CONST file name) : + + enable stop ; + FILE VAR input file, output file; + DATASPACE VAR scratch space; + INT CONST type of dataspace := type (old (file name)) ; + INT VAR counter; + + last param (file name); + IF type of dataspace = file type + THEN reorganize new to new + ELIF type of dataspace = file type 16 + THEN reorganize old to new + ELSE errorstop ("Datenraum hat falschen Typ") + FI; + replace file space by scratch space . + +reorganize new to new : + input file := sequential file (input, file name); + disable stop ; + scratch space := nilspace ; + output file := sequential file (output, scratch space); + copy attributes (input file, output file) ; + + FOR counter FROM 1 UPTO 9999 + WHILE NOT eof (input file) REP + cout (counter); + getline (input file, file record); + putline (output file, file record); + check for interrupt + PER . + +reorganize old to new : + LET OLDRECORD = STRUCT (INT succ, pred, x, y, TEXT record); + LET OLDFILE = BOUND ROW 4075 OLDRECORD; + LET dateianker = 2, freianker = 1; + INT VAR index := dateianker; + + OLDFILE VAR old file := old (file name); + disable stop; + scratch space := nilspace; + output file := sequential file (output, scratch space); + get old attributes ; + + say ("Datei wird in 1.7-Format gewandelt: ") ; + + FOR counter FROM 1 UPTO 9999 + WHILE NOT end of old file REP + cout (counter); + index := next record; + file record := record of old file ; + IF pos (file record, ""128"", ""250"", 1) > 0 + THEN change special chars + FI ; + putline (output file, file record); + check for interrupt + PER . + +get old attributes : + get old headline ; + get old limit and tabs . + +get old headline : + headline (output file, old file (dateianker).record) . + +get old limit and tabs : + file record := old file (freianker).record ; + max line length (output file, int (subtext (file record, 11, 15))) ; + put tabs (output file, subtext (file record, 16)) . + +change special chars : + change all (file record, ""193"", ""214"") (* Ae *) ; + change all (file record, ""207"", ""215"") (* Oe *) ; + change all (file record, ""213"", ""216"") (* Ue *) ; + change all (file record, ""225"", ""217"") (* ae *) ; + change all (file record, ""239"", ""218"") (* oe *) ; + change all (file record, ""245"", ""219"") (* ue *) ; + change all (file record, ""235"", ""220"") (* k *) ; + change all (file record, ""173"", ""221"") (* - *) ; + change all (file record, ""163"", ""222"") (* fis *) ; + change all (file record, ""160"", ""223"") (* blank *) ; + change all (file record, ""194"", ""251"") (* eszet *) . + +end of old file : next record = dateianker . + +next record : old file (index).succ . + +record of old file : old file (index).record . + +check for interrupt : + INT VAR size, used ; + storage (size, used) ; + IF used > size + THEN errorstop ("Speicherengpass") + FI ; + IF is error + THEN forget (scratch space) ; LEAVE reorganize + FI . + +replace file space by scratch space : + headline (output file, file name); + forget (file name, quiet) ; + type (scratch space, file type); + copy (scratch space, file name); + forget (scratch space) . + +END PROC reorganize; + + +PROC set range (FILE VAR f, INT CONST start line, start col, + FRANGE VAR old range) : + + check mode (f, mod); + IF valid restriction parameters + THEN prepare last line ; + prepare first line ; + save old range ; + set new range + ELSE errorstop ("FRANGE ungueltig") + FI . + +valid restriction parameters : + start line > 0 AND start col > 0 AND start before or at actual point . + +start before or at actual point : + start line < line no (f) OR + start line = line no (f) AND start col <= col (f) . + +prepare last line : + INT VAR last line ; + IF col (f) > 1 + THEN split line (f, col(f), FALSE) + FI . + +prepare first line : + IF start col > 1 + THEN split start line ; + FI . + +split start line : + INT VAR old line no := line no (f) ; + to line (f, start line) ; + split line (f, start col, FALSE) ; + to line (f, old line no + 1) . + +save old range : + old range.pre := f.prefix lines ; + old range.post:= f.postfix lines . + +set new range : + get pre lines ; + get post lines ; + disable stop ; + f.prefix lines INCR pre lines ; + f.postfix lines INCR post lines ; + f.used.lines DECR (post lines + pre lines) ; + f.used.line no DECR pre lines . + +get pre lines : + INT VAR pre lines ; + IF start col = 1 + THEN old range.pre was split := FALSE ; + pre lines := start line - 1 + ELSE old range.pre was split := TRUE ; + pre lines := start line + FI . + +get post lines : + INT VAR post lines ; + IF col (f) = 1 + THEN old range.post was split := FALSE ; + post lines := lines (f) - line no (f) + 1 + ELSE old range.post was split := TRUE ; + post lines := lines (f) - line no (f) + FI . + +END PROC set range; + + +PROC set range (FILE VAR f, FRANGE VAR new range) : + + check mode (f, mod); + INT CONST pre add := prefix - new range.pre, + post add := postfix - new range.post; + IF pre add < 0 OR post add < 0 + THEN errorstop ("FRANGE ungueltig") + ELSE set new range; + undo splitting if necessary ; + make range var invalid + FI . + +set new range : + disable stop; + prefix DECR pre add; + postfix DECR post add; + used.line no INCR pre add; + used.lines INCR (pre add + post add) . + +undo splitting if necessary : + IF new range.pre was split + THEN concatenate first line + FI ; + IF new range.post was split + THEN concatenate last line + FI . + +concatenate first line : + INT VAR old line := line no (f) ; + to line (f, pre add) ; + concatenate line (f, FALSE) ; + to line (f, old line - 1) . + +concatenate last line : + old line := line no (f) ; + to line (f, lines (f) - post add) ; + concatenate line (f, FALSE) ; + to line (f, old line) . + +make range var invalid : + new range.pre := maxint . + +used : f.used . +prefix : f.prefix lines . +postfix : f.postfix lines . + +END PROC set range; + +PROC reset range (FILE VAR f) : + + FRANGE VAR complete ; + complete.pre := 0 ; + complete.post:= 0 ; + complete.pre was split := FALSE ; + complete.post was split:= FALSE ; + set range (f, complete) + +ENDPROC reset range ; + +PROC remove (FILE VAR f, INT CONST size) : + + check mode (f, mod); + transfer subsequence (f.used, f.scratch, f.atoms, size) . + +END PROC remove; + + +PROC clear removed (FILE VAR f) : + + check mode (f, mod); + transfer subsequence (f.scratch, f.free, f.atoms, f.scratch.lines) . + +END PROC clear removed; + + +PROC reinsert (FILE VAR f) : + + check mode (f, mod); + transfer subsequence (f.scratch, f.used, f.atoms, f.scratch.lines) . + +END PROC reinsert; + + +PROC copy attributes (FILE CONST source file, FILE VAR dest file) : + + dest.limit := source.limit ; + dest.atoms (free root).line := source.atoms (free root).line ; + dest.atoms (scratch root).line := source.atoms (scratch root).line ; + dest.edit info := source.edit info . + +dest : CONCR (CONCR (dest file)) . +source : CONCR (CONCR (source file)) . + +ENDPROC copy attributes ; + + +INT PROC max line length (FILE CONST f) : + + f.limit . + +END PROC max line length; + + +PROC max line length (FILE VAR f, INT CONST new limit) : + + IF new limit > 0 AND new limit <= max limit + THEN f.limit := new limit + FI . + +END PROC max line length; + + +TEXT PROC headline (FILE CONST f) : + + f.atoms (free root).line . + +END PROC headline; + + +PROC headline (FILE VAR f, TEXT CONST head) : + + f.atoms (free root).line := head . + +END PROC headline; + + +PROC get tabs (FILE CONST f, TEXT VAR tabs) : + + tabs := f.atoms (scratch root).line . + +END PROC get tabs; + + +PROC put tabs (FILE VAR f, TEXT CONST tabs) : + + f.atoms (scratch root).line := tabs . + +END PROC put tabs; + + +INT PROC edit info (FILE CONST f) : + + f.edit info . + +END PROC edit info; + + +PROC edit info (FILE VAR f, INT CONST info) : + + f.edit info := info . + +END PROC edit info; + + +INT PROC lines (FILE CONST f) : + + f.used.lines . + +END PROC lines; + + +INT PROC removed lines (FILE CONST f) : + + f.scratch.lines . + +END PROC removed lines; + + +INT PROC segments (FILE CONST f) : + + segs(f.used,f.atoms) + segs(f.scratch,f.atoms) + segs(f.free,f.atoms) - 2 . + +ENDPROC segments ; + + +INT PROC col (FILE CONST f) : + + f.col + +ENDPROC col ; + +PROC col (FILE VAR f, INT CONST new column) : + + IF new column > 0 + THEN f.col := new column + FI + +ENDPROC col ; + +TEXT PROC word (FILE CONST f) : + + word (f, " ") + +ENDPROC word ; + +TEXT PROC word (FILE CONST f, TEXT CONST delimiter) : + + INT VAR del pos := pos (f, delimiter, col (f)) ; + IF del pos = 0 + THEN del pos := len (f) + 1 + FI ; + subtext (f, col (f), del pos - 1) + +ENDPROC word ; + +TEXT PROC word (FILE CONST f, INT CONST max length) : + + subtext (f, col (f), col (f) + max length - 1) + +ENDPROC word ; + +BOOL PROC at (FILE CONST f, TEXT CONST word) : + + pat := any (column-1) ; + pat CAT word ; + pat CAT any ; + record LIKE pat . + +column : f.col . +record : f.atoms (f.used.index).line . + +ENDPROC at ; + + +PROC exec (PROC (TEXT VAR, TEXT CONST) proc, FILE VAR f, TEXT CONST t) : + + proc (record, t) . + +record : f.atoms (f.used.index).line . + +END PROC exec; + + +PROC exec (PROC (TEXT VAR, INT CONST) proc, FILE VAR f, INT CONST i) : + + proc (record, i) . + +record : f.atoms (f.used.index).line . + +END PROC exec; + +INT PROC pos (FILE CONST f, TEXT CONST pattern, INT CONST i) : + + pos (record, pattern, i) . + +record : f.atoms (f.used.index).line . + +END PROC pos ; + +PROC down (FILE VAR f, TEXT CONST pattern) : + + down (f, pattern, file size) + +ENDPROC down ; + +PROC down (FILE VAR f, TEXT CONST pattern, INT CONST max line) : + + check mode (f,mod) ; + INT VAR pattern pos := f.col + 1 ; + search down (f.used, f.atoms, pattern, max line, pattern pos) ; + f.col := pattern pos + +ENDPROC down ; + +PROC downety (FILE VAR f, TEXT CONST pattern) : + + downety (f, pattern, file size) + +ENDPROC downety ; + +PROC downety (FILE VAR f, TEXT CONST pattern, INT CONST max line) : + + check mode (f,mod) ; + INT VAR pattern pos := f.col ; + search down (f.used, f.atoms, pattern, max line, pattern pos) ; + f.col := pattern pos + +ENDPROC downety ; + +PROC up (FILE VAR f, TEXT CONST pattern) : + + up (f, pattern, file size) + +ENDPROC up ; + +PROC up (FILE VAR f, TEXT CONST pattern, INT CONST max line) : + + check mode (f,mod) ; + INT VAR pattern pos := f.col - 1 ; + search up (f.used, f.atoms, pattern, max line, pattern pos) ; + f.col := pattern pos + +ENDPROC up ; + +PROC uppety (FILE VAR f, TEXT CONST pattern) : + + uppety (f, pattern, file size) + +ENDPROC uppety ; + +PROC uppety (FILE VAR f, TEXT CONST pattern, INT CONST max line) : + + check mode (f,mod) ; + INT VAR pattern pos := f.col ; + search up (f.used, f.atoms, pattern, max line, pattern pos) ; + f.col := pattern pos + +ENDPROC uppety ; + + +INT PROC len (FILE CONST f) : + + length (record) . + +record : f.atoms (f.used.index).line . + +ENDPROC len ; + +TEXT PROC subtext (FILE CONST f, INT CONST from, to) : + + subtext (record, from, to) . + +record : f.atoms (f.used.index).line . + +ENDPROC subtext ; + +PROC change (FILE VAR f, INT CONST from, to, TEXT CONST new) : + + check mode (f, mod) ; + change (record, from, to, new) . + +record : f.atoms (f.used.index).line . + +ENDPROC change ; + + +BOOL PROC mark (FILE CONST f) : + + f.mark line > 0 + +ENDPROC mark ; + +PROC mark (FILE VAR f, INT CONST line no, col) : + + IF line no > 0 + THEN f.mark line := line no + f.prefix lines ; + f.mark col := col + ELSE f.mark line := 0 ; + f.mark col := 0 + FI + +ENDPROC mark ; + +INT PROC mark line no (FILE CONST f) : + + IF f.mark line = 0 + THEN 0 + ELSE max (1, f.mark line - f.prefix lines) + FI + +ENDPROC mark line no ; + +INT PROC mark col (FILE CONST f) : + + IF f.mark line = 0 + THEN 0 + ELIF f.mark line <= f.prefix lines + THEN 1 + ELSE f.mark col + FI + +ENDPROC mark col ; + +PROC set marked range (FILE VAR f, FRANGE VAR old range) : + + IF mark (f) + THEN set range (f, mark line no (f), mark col (f), old range) + ELSE old range := previous range of file + FI . + +previous range of file : + FRANGE : (f.prefix lines, f.postfix lines, FALSE, FALSE) . + +ENDPROC set marked range ; + + +(*****************************************************************) + + (* Autor: P.Heyderhoff *) + (* Stand: 11.10.83 *) + +BOUND LIST VAR datei; +INT VAR sortierstelle, sortanker; +BOOL VAR ascii sort; +TEXT VAR median, tausch , links, rechts; + +PROC sort (TEXT CONST dateiname) : + sort (dateiname, 1) +END PROC sort; + +PROC sort (TEXT CONST dateiname, INT CONST sortieranfang) : + ascii sort := TRUE ; + sortierstelle := sortieranfang; sortiere (dateiname) +END PROC sort; + +PROC lex sort (TEXT CONST dateiname) : + lex sort (dateiname, 1) +ENDPROC lex sort ; + +PROC lex sort (TEXT CONST dateiname, INT CONST sortieranfang) : + ascii sort := FALSE ; + sortierstelle := sortieranfang; sortiere (dateiname) +ENDPROC lex sort ; + +PROC sortiere (TEXT CONST dateiname) : + + reorganize file if necessary ; + sort file . + +reorganize file if necessary : + FILE VAR f := sequential file (modify, dateiname) ; + IF segments (f) > 1 + THEN reorganize (dateiname) + FI . + +sort file : + f := sequential file (modify, dateiname) ; + INT CONST sortende := lines (f) + 3 ; + sortanker := 1 + 3 ; + datei := old (dateiname) ; + quicksort(sortanker, sortende) . + +END PROC sortiere; + +PROC quicksort ( INT CONST anfang, ende ) : + IF anfang < ende + THEN INT VAR p,q; + spalte (anfang, ende, p, q); + quicksort (anfang, q); + quicksort (p, ende) FI +END PROC quicksort; + +PROC spalte (INT CONST anfang, ende, INT VAR p, q): + fange an der seite an und waehle den median; + ruecke p und q so dicht wie moeglich zusammen; + hole ggf median in die mitte . + + fange an der seite an und waehle den median : + p := anfang; q := ende ; + INT CONST m :: (p + q) DIV 2 ; + median := subtext(datei m, sortierstelle) . + + ruecke p und q so dicht wie moeglich zusammen : + REP schiebe p und q so weit wie moeglich auf bzw ab; + IF p < q THEN vertausche die beiden FI + UNTIL p > q END REP . + + vertausche die beiden : + tausch := datei p; datei p := datei q; datei q := tausch; + p INCR 1; q DECR 1 . + + schiebe p und q so weit wie moeglich auf bzw ab : + WHILE p kann groesser werden REP p INCR 1 END REP; + WHILE q kann kleiner werden REP q DECR 1 END REP . + + p kann groesser werden : + IF p <= ende + THEN links := subtext (datei p, sortierstelle) ; + IF ascii sort + THEN median >= links + ELSE median LEXGREATEREQUAL links + FI + ELSE FALSE + FI . + + q kann kleiner werden : + IF q >= anfang + THEN rechts := subtext(datei q, sortierstelle) ; + IF ascii sort + THEN rechts >= median + ELSE rechts LEXGREATEREQUAL median + FI + ELSE FALSE + FI . + + hole ggf median in die mitte : + IF m < q THEN vertausche m und q + ELIF m > p THEN vertausche m und p FI . + + vertausche m und q : + tausch := datei m; datei m := datei q; datei q := tausch; q DECR 1 . + + vertausche m und p : + tausch := datei m; datei m := datei p; datei p := tausch; p INCR 1 . + + datei m : datei.atoms (m).line . + datei p : datei.atoms (p).line . + datei q : datei.atoms (q).line . + +END PROC spalte; + +END PACKET file handling; + |