summaryrefslogtreecommitdiff
path: root/app/diskettenmonitor/3.5/src/read heap
blob: 533e78c17e5660e0790de0840092d75d6675af8a (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
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;