-
Notifications
You must be signed in to change notification settings - Fork 0
/
RISC.Modules.Mod.txt
225 lines (214 loc) · 9.15 KB
/
RISC.Modules.Mod.txt
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
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
MODULE Modules; (*Link and load on RISC; NW 20.10.2013 / 8.1.2019*)
IMPORT SYSTEM, Files;
CONST versionkey = 1X; MT = 12; DescSize = 80;
TYPE Module* = POINTER TO ModDesc;
Command* = PROCEDURE;
ModuleName* = ARRAY 32 OF CHAR;
ModDesc* = RECORD
name*: ModuleName;
next*: Module;
key*, num*, size*, refcnt*: INTEGER;
data*, code*, imp*, cmd*, ent*, ptr*, unused: INTEGER (*addresses*)
END ;
VAR root*, M: Module;
MTOrg*, AllocPtr*, res*: INTEGER;
importing*, imported*: ModuleName;
limit: INTEGER;
PROCEDURE ThisFile(name: ARRAY OF CHAR): Files.File;
VAR i: INTEGER;
filename: ModuleName;
BEGIN i := 0;
WHILE name[i] # 0X DO filename[i] := name[i]; INC(i) END ;
filename[i] := "."; filename[i+1] := "r"; filename[i+2] := "s"; filename[i+3] := "c"; filename[i+4] := 0X;
RETURN Files.Old(filename)
END ThisFile;
PROCEDURE error(n: INTEGER; name: ARRAY OF CHAR);
BEGIN res := n; importing := name
END error;
PROCEDURE Check(s: ARRAY OF CHAR);
VAR i: INTEGER; ch: CHAR;
BEGIN ch := s[0]; res := 1; i := 1;
IF (ch >= "A") & (ch <= "Z") OR (ch >= "a") & (ch <= "z") THEN
REPEAT ch := s[i]; INC(i)
UNTIL ~((ch >= "0") & (ch <= "9") OR (ch >= "A") & (ch <= "Z")
OR (ch >= "a") & (ch <= "z") OR (ch = ".")) OR (i = 32);
IF (i < 32) & (ch = 0X) THEN res := 0 END
END
END Check;
PROCEDURE Load*(name: ARRAY OF CHAR; VAR newmod: Module);
(*search module in list; if not found, load module.
res = 0: already present or loaded; res = 2: file not available; res = 3: key conflict;
res = 4: bad file version; res = 5: corrupted file; res = 7: no space*)
VAR mod, impmod: Module;
i, n, key, impkey, mno, nofimps, size: INTEGER;
p, u, v, w: INTEGER; (*addresses*)
ch: CHAR;
body: Command;
fixorgP, fixorgD, fixorgT: INTEGER;
disp, adr, inst, pno, vno, dest, offset: INTEGER;
name1, impname: ModuleName;
F: Files.File; R: Files.Rider;
import: ARRAY 16 OF Module;
BEGIN mod := root; error(0, name); nofimps := 0;
WHILE (mod # NIL) & (name # mod.name) DO mod := mod.next END ;
IF mod = NIL THEN (*load*)
Check(name);
IF res = 0 THEN F := ThisFile(name) ELSE F := NIL END ;
IF F # NIL THEN
Files.Set(R, F, 0); Files.ReadString(R, name1); Files.ReadInt(R, key); Files.Read(R, ch);
Files.ReadInt(R, size); importing := name1;
IF ch = versionkey THEN
Files.ReadString(R, impname); (*imports*)
WHILE (impname[0] # 0X) & (res = 0) DO
Files.ReadInt(R, impkey);
Load(impname, impmod); import[nofimps] := impmod; importing := name1;
IF res = 0 THEN
IF impmod.key = impkey THEN INC(impmod.refcnt); INC(nofimps)
ELSE error(3, name1); imported := impname
END
END ;
Files.ReadString(R, impname)
END
ELSE error(2, name1)
END
ELSE error(1, name)
END ;
IF res = 0 THEN (*search for a hole in the list allocate and link*)
INC(size, DescSize); mod := root;
WHILE (mod # NIL) & ~((mod.name[0] = 0X) & (mod.size >= size)) DO mod := mod.next END ;
IF mod = NIL THEN (*no large enough hole was found*)
IF AllocPtr + size < limit THEN (*allocate*)
p := AllocPtr; mod := SYSTEM.VAL(Module, p);
AllocPtr := (p + size + 100H) DIV 20H * 20H; mod.size := AllocPtr - p; mod.num := root.num + 1;
mod.next := root; root := mod
ELSE error(7, name1)
END
ELSE (*fill hole*) p := SYSTEM.VAL(INTEGER, mod)
END
END ;
IF res = 0 THEN (*read file*)
INC(p, DescSize); (*allocate descriptor*)
mod.name := name; mod.key := key; mod.refcnt := 0;
mod.data := p; (*data*)
SYSTEM.PUT(mod.num * 4 + MTOrg, p); (*module table entry*)
Files.ReadInt(R, n);
WHILE n > 0 DO Files.ReadInt(R, w); SYSTEM.PUT(p, w); INC(p, 4); DEC(n, 4) END ; (*type descriptors*)
Files.ReadInt(R, n);
WHILE n > 0 DO SYSTEM.PUT(p, 0); INC(p, 4); DEC(n, 4) END ; (*variable space*)
Files.ReadInt(R, n);
WHILE n > 0 DO Files.Read(R, ch); SYSTEM.PUT(p, ch); INC(p); DEC(n) END ; (*strings*)
mod.code := p; (*program*)
Files.ReadInt(R, n);
WHILE n > 0 DO Files.ReadInt(R, w); SYSTEM.PUT(p, w); INC(p, 4); DEC(n) END ; (*program code*)
mod.imp := p; (*copy imports*)
i := 0;
WHILE i < nofimps DO
SYSTEM.PUT(p, import[i]); INC(p, 4); INC(i)
END ;
mod.cmd := p; (*commands*) Files.Read(R, ch);
WHILE ch # 0X DO
REPEAT SYSTEM.PUT(p, ch); INC(p); Files.Read(R, ch) UNTIL ch = 0X;
REPEAT SYSTEM.PUT(p, 0X); INC(p) UNTIL p MOD 4 = 0;
Files.ReadInt(R, n); SYSTEM.PUT(p, n); INC(p, 4); Files.Read(R, ch)
END ;
REPEAT SYSTEM.PUT(p, 0X); INC(p) UNTIL p MOD 4 = 0;
mod.ent := p; (*entries*)
Files.ReadInt(R, n);
WHILE n > 0 DO Files.ReadInt(R, w); SYSTEM.PUT(p, w); INC(p, 4); DEC(n) END ;
mod.ptr := p; (*pointer references*)
Files.ReadInt(R, w);
WHILE w >= 0 DO SYSTEM.PUT(p, mod.data + w); INC(p, 4); Files.ReadInt(R, w) END ;
SYSTEM.PUT(p, 0); INC(p, 4);
Files.ReadInt(R, fixorgP); Files.ReadInt(R, fixorgD); Files.ReadInt(R, fixorgT);
Files.ReadInt(R, w); body := SYSTEM.VAL(Command, mod.code + w);
Files.Read(R, ch);
IF ch # "O" THEN (*corrupted file*) mod := NIL; error(4, name) END
END ;
IF res = 0 THEN (*fixup of BL*)
adr := mod.code + fixorgP*4;
WHILE adr # mod.code DO
SYSTEM.GET(adr, inst);
mno := inst DIV 100000H MOD 10H;
pno := inst DIV 1000H MOD 100H;
disp := inst MOD 1000H;
SYSTEM.GET(mod.imp + (mno-1)*4, impmod);
SYSTEM.GET(impmod.ent + pno*4, dest); dest := dest + impmod.code;
offset := (dest - adr - 4) DIV 4;
SYSTEM.PUT(adr, (offset MOD 1000000H) + 0F7000000H);
adr := adr - disp*4
END ;
(*fixup of LDR/STR/ADD*)
adr := mod.code + fixorgD*4;
WHILE adr # mod.code DO
SYSTEM.GET(adr, inst);
mno := inst DIV 100000H MOD 10H;
disp := inst MOD 1000H;
IF mno = 0 THEN (*global*)
SYSTEM.PUT(adr, (inst DIV 1000000H * 10H + MT) * 100000H + mod.num * 4)
ELSE (*import*)
SYSTEM.GET(mod.imp + (mno-1)*4, impmod); v := impmod.num;
SYSTEM.PUT(adr, (inst DIV 1000000H * 10H + MT) * 100000H + v*4);
SYSTEM.GET(adr+4, inst); vno := inst MOD 100H;
SYSTEM.GET(impmod.ent + vno*4, offset);
IF ODD(inst DIV 100H) THEN offset := offset + impmod.code - impmod.data END ;
SYSTEM.PUT(adr+4, inst DIV 10000H * 10000H + offset)
END ;
adr := adr - disp*4
END ;
(*fixup of type descriptors*)
adr := mod.data + fixorgT*4;
WHILE adr # mod.data DO
SYSTEM.GET(adr, inst);
mno := inst DIV 1000000H MOD 10H;
vno := inst DIV 1000H MOD 1000H;
disp := inst MOD 1000H;
IF mno = 0 THEN (*global*) inst := mod.data + vno
ELSE (*import*)
SYSTEM.GET(mod.imp + (mno-1)*4, impmod);
SYSTEM.GET(impmod.ent + vno*4, offset);
inst := impmod.data + offset
END ;
SYSTEM.PUT(adr, inst); adr := adr - disp*4
END ;
body (*initialize module*)
ELSIF res >= 3 THEN importing := name;
WHILE nofimps > 0 DO DEC(nofimps); DEC(import[nofimps].refcnt) END
END
END ;
newmod := mod
END Load;
PROCEDURE ThisCommand*(mod: Module; name: ARRAY OF CHAR): Command;
VAR k, adr, w: INTEGER; ch: CHAR;
s: ARRAY 32 OF CHAR;
BEGIN res := 5; w := 0;
IF mod # NIL THEN
adr := mod.cmd; SYSTEM.GET(adr, ch);
WHILE (ch # 0X) & (res # 0) DO k := 0; (*read command name*)
REPEAT s[k] := ch; INC(k); INC(adr); SYSTEM.GET(adr, ch) UNTIL ch = 0X;
s[k] := 0X;
REPEAT INC(adr) UNTIL adr MOD 4 = 0;
SYSTEM.GET(adr, k); INC(adr, 4);
IF s = name THEN res := 0; w := mod.code + k ELSE SYSTEM.GET(adr, ch) END
END
END
RETURN SYSTEM.VAL(Command, w)
END ThisCommand;
PROCEDURE Free*(name: ARRAY OF CHAR);
VAR mod, imp: Module; p, q: INTEGER;
BEGIN mod := root; res := 0;
WHILE (mod # NIL) & (mod.name # name) DO mod := mod.next END ;
IF mod # NIL THEN
IF mod.refcnt = 0 THEN
mod.name[0] := 0X; p := mod.imp; q := mod.cmd;
WHILE p < q DO SYSTEM.GET(p, imp); DEC(imp.refcnt); INC(p, 4) END ;
ELSE res := 1
END
END
END Free;
PROCEDURE Init*;
BEGIN Files.Init; MTOrg := SYSTEM.REG(MT);
SYSTEM.GET(16, AllocPtr); SYSTEM.GET(20, root); SYSTEM.GET(24, limit); DEC(limit, 8000H)
END Init;
BEGIN Init; Load("Oberon", M);
LED(res); REPEAT UNTIL FALSE (*only if load fails*)
END Modules.