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
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
|
DATASPACE VARd:=nilspace; forget(d);
BOUND TEXT VAR t;
INT CONST c := channel;
LET a = 31;
INT VAR block, anfang, ende, weiter;
disablestop;
exec;
forget(d);
break (quiet);
continue (c);
PROC blockin :
block INCR 1;
INT VAR error;
replace (t, anfang, subtext (t, weiter));
blockin (d, 3, 0, block, error);
IF error <> 0 THEN
errorstop ("Fehlercode "+text (error)+" auf Block "+text(block))
FI;
END PROC blockin;
PROC exec :
enable stop;
TEXT VAR zeile := "datei";
editget (zeile);
IF exists (zeile) THEN forget (zeile) FI;
FILE VAR f := sequential file (output, new (zeile));
forget (d); d := nilspace;
t := d;
t := "";
REP
t CAT ""255"";
anfang := LENGTH t;
UNTIL dspages (d) = 2 PER;
REP
ende := LENGTH t;
t CAT ""255"";
UNTIL dspages (d) > 2 PER;
weiter := LENGTH t;
t := subtext (t, 1, ende);
t CAT subtext (t, anfang);
put (anfang); put (ende); put (weiter); put (LENGTH t);
put (weiter - anfang); put (LENGTH t - ende); line;
continue (a);
control (5, 0, 0, block);
block := -1;
blockin;
block := 406;
blockin; (* 407 lesen (ans ende) *)
replace (t, LENGTH t DIV 2, 12352);
INT VAR p := LENGTH t - 1, o;
(*
INT VAR p := pos (t, ""255"", weiter), o;
IF p <> 0 THEN p := pos (t, ""0"", ""254"", p);
FI;
*)
zeile := "";
REP
naechsten block verarbeiten;
blockin;
p DECR weiter;
p INCR anfang;
UNTIL block > 1170 PER;
errorstop ("kein ende gefunden") .
naechsten block verarbeiten :
REP
IF p < anfang COR p MOD 2 = 0 THEN
errorstop ("Fehler bei "+text(block)+", "+text (p - anfang));
FI;
IF p > ende THEN LEAVE naechsten block verarbeiten FI;
continue (c);
put (block - 1);
put (p -anfang);
INT VAR l := t ISUB p DIV 2 + 1;
put (l);
IF l <= 0 THEN (* continue (c);
put (block); put (p - anfang); put (l); *) LEAVE exec
FI;
put ("");
continue (a);
p INCR 2;
IF p + l - 1 > LENGTH t THEN
l INCR LENGTH zeile;
zeile CAT subtext (t, p);
l DECR LENGTH zeile;
replace (t, LENGTH t DIV 2, l);
p := LENGTH t - 1;
ELSE
o := LENGTH zeile;
zeile CAT subtext (t, p, p + l - 1);
p INCR l;
l INCR o;
IF LENGTH zeile <> l THEN
errorstop ("Laengenfehler bei "+text(block)+", "+text (p - anfang)
+", "+text(LENGTH zeile));
FI;
WHILE (zeile SUB l) = ""255"" REP l DECR 1 PER;
zeile := subtext (zeile, 1, l);
putline (f, zeile);
zeile := "";
FI;
PER .
END PROC exec;
|
