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
|
PACKET eu disk DEFINES (* Copyright (C) 1986, 87 *)
(* Frank Klapper *)
(* 05.01.87 *)
load shard interface table,
open eu disk,
eu size,
eu heads,
eu tracks,
eu first sector,
eu last sector:
LET table length = 15,
size field = 1,
head field = 2,
track field = 3,
first sector field = 4,
last sector field = 5;
ROW table length ROW 5 INT VAR format table;
INT VAR table top := 0,
table pointer;
PROC open eu disk:
enable stop;
init check rerun;
IF hd version
THEN LEAVE open eu disk
FI;
INT CONST blocks := archive blocks;
IF blocks <= 0
THEN error stop ("keine Diskette eingelegt")
FI;
search format table entry.
search format table entry:
IF table top < 1
THEN error stop ("SHard-Interfacetabelle nicht geladen")
FI;
table pointer := 1;
WHILE format table [table pointer][size field] <> blocks REP
table pointer INCR 1;
IF table pointer > table top
THEN error stop ("Diskettenformat nicht implementiert")
FI
PER.
END PROC open eu disk;
PROC load shard interface table:
FILE VAR f := sequential file (input, "shard interface");
TEXT VAR line;
table top := 0;
WHILE NOT eof (f) REP
get line (f, line);
IF (line SUB 1) <> ";"
THEN load line
FI
PER.
load line:
table top INCR 1;
IF table top > table length
THEN error stop ("Shard Interface Tabelle zu groß")
FI;
INT VAR blank pos := 1;
format table [table top][size field] := next int;
format table [table top][head field] := next int;
format table [table top][track field] := next int;
format table [table top][first sector field] := next int;
format table [table top][last sector field] := next int.
next int:
line := compress (subtext (line, blank pos)) + " ";
blank pos := pos (line, " ");
int (subtext (line, 1, blank pos - 1)).
END PROC load shard interface table;
INT PROC eu size:
format table [table pointer][size field]
END PROC eu size;
INT PROC eu heads:
format table [table pointer][head field]
END PROC eu heads;
INT PROC eu tracks:
format table [table pointer][track field]
END PROC eu tracks;
INT PROC eu first sector:
format table [table pointer][first sector field]
END PROC eu first sector;
INT PROC eu last sector:
format table [table pointer][last sector field]
END PROC eu last sector;
END PACKET eu disk;
|
