GenericLoader.Mod 19 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694
  1. MODULE GenericLoader; (** AUTHOR "fof"; PURPOSE "Active Oberon Generic Object File Loader"; *)
  2. (* cf. Linker *)
  3. IMPORT SYSTEM, KernelLog, Modules, Streams, Files, D := KernelLog, GenericLinker, ObjectFile, Diagnostics, Strings, StringPool, Trace, Machine;
  4. CONST
  5. Ok = 0;
  6. LinkerError=3400;
  7. FileNotFound = 3401;
  8. SupportOldObjectFileFormat = FALSE;
  9. TraceLoading = FALSE;
  10. TYPE
  11. HashEntryIntInt = RECORD
  12. key,value: LONGINT;
  13. END;
  14. HashIntArray = POINTER TO ARRAY OF HashEntryIntInt;
  15. HashEntryIntAny = RECORD
  16. key: LONGINT; value: ANY;
  17. END;
  18. HashIntAnyArray = POINTER TO ARRAY OF HashEntryIntAny;
  19. HashTableInt = OBJECT
  20. VAR
  21. table: HashIntArray;
  22. size: LONGINT;
  23. used-: LONGINT;
  24. maxLoadFactor: REAL;
  25. (* Interface *)
  26. PROCEDURE & Init* (initialSize: LONGINT);
  27. BEGIN
  28. ASSERT(initialSize > 2);
  29. NEW(table, initialSize);
  30. size := initialSize;
  31. used := 0;
  32. maxLoadFactor := 0.75;
  33. END Init;
  34. PROCEDURE Put*(key: LONGINT; value: LONGINT);
  35. VAR hash: LONGINT;
  36. BEGIN
  37. ASSERT(key # 0);
  38. ASSERT(used < size);
  39. hash := HashValue(key);
  40. IF table[hash].key = 0 THEN
  41. INC(used, 1);
  42. END;
  43. table[hash].key := key;
  44. table[hash].value := value;
  45. IF (used / size) > maxLoadFactor THEN Grow END;
  46. END Put;
  47. PROCEDURE Get*(key: LONGINT):LONGINT;
  48. BEGIN
  49. RETURN table[HashValue(key)].value;
  50. END Get;
  51. PROCEDURE Has*(key: LONGINT):BOOLEAN;
  52. BEGIN
  53. RETURN table[HashValue(key)].key = key;
  54. END Has;
  55. PROCEDURE Length*():LONGINT;
  56. BEGIN RETURN used; END Length;
  57. PROCEDURE Clear*;
  58. VAR i: LONGINT;
  59. BEGIN FOR i := 0 TO size - 1 DO table[i].key := 0; END; END Clear;
  60. (* Internals *)
  61. PROCEDURE HashValue(key: LONGINT):LONGINT;
  62. VAR value, h1, h2, i: LONGINT;
  63. BEGIN
  64. i := 0;
  65. value := key;
  66. h1 := key MOD size;
  67. h2 := 1; (* Linear probing *)
  68. REPEAT
  69. value := (h1 + i*h2) MOD size;
  70. INC(i);
  71. UNTIL((table[value].key = 0) OR (table[value].key = key) OR (i > size));
  72. ASSERT((table[value].key = 0) OR (table[value].key = key));
  73. RETURN value;
  74. END HashValue;
  75. PROCEDURE Grow;
  76. VAR oldTable: HashIntArray; oldSize, i, key: LONGINT;
  77. BEGIN
  78. oldSize := size;
  79. oldTable := table;
  80. Init(size*2);
  81. FOR i := 0 TO oldSize-1 DO
  82. key := oldTable[i].key;
  83. IF key # 0 THEN
  84. Put(key, oldTable[i].value);
  85. END;
  86. END;
  87. END Grow;
  88. END HashTableInt;
  89. HashTableIntAny* = OBJECT
  90. VAR
  91. table: HashIntAnyArray;
  92. size: LONGINT;
  93. used-: LONGINT;
  94. maxLoadFactor: REAL;
  95. (* Interface *)
  96. PROCEDURE & Init* (initialSize: LONGINT);
  97. BEGIN
  98. ASSERT(initialSize > 2);
  99. NEW(table, initialSize);
  100. size := initialSize;
  101. used := 0;
  102. maxLoadFactor := 0.75;
  103. END Init;
  104. PROCEDURE Put*(key: LONGINT; value: ANY);
  105. VAR hash: LONGINT;
  106. BEGIN
  107. ASSERT(key # 0);
  108. ASSERT(used < size);
  109. hash := HashValue(key);
  110. IF table[hash].key = 0 THEN
  111. INC(used, 1);
  112. END;
  113. table[hash].key := key;
  114. table[hash].value := value;
  115. IF (used / size) > maxLoadFactor THEN Grow END;
  116. END Put;
  117. PROCEDURE Get*(key: LONGINT):ANY;
  118. BEGIN
  119. RETURN table[HashValue(key)].value;
  120. END Get;
  121. PROCEDURE Has*(key: LONGINT):BOOLEAN;
  122. BEGIN
  123. RETURN table[HashValue(key)].key = key;
  124. END Has;
  125. PROCEDURE Length*():LONGINT;
  126. BEGIN RETURN used; END Length;
  127. PROCEDURE Clear*;
  128. VAR i: LONGINT;
  129. BEGIN FOR i := 0 TO size - 1 DO table[i].key := 0; END; END Clear;
  130. (* Interface for integer values *)
  131. (* Internals *)
  132. PROCEDURE HashValue(key: LONGINT):LONGINT;
  133. VAR value, h1, h2, i: LONGINT;
  134. BEGIN
  135. i := 0;
  136. value := key;
  137. h1 := key MOD size;
  138. h2 := 1; (* Linear probing *)
  139. REPEAT
  140. value := (h1 + i*h2) MOD size;
  141. INC(i);
  142. UNTIL((table[value].key = 0) OR (table[value].key = key) OR (i > size));
  143. ASSERT((table[value].key = 0) OR (table[value].key = key));
  144. RETURN value;
  145. END HashValue;
  146. PROCEDURE Grow;
  147. VAR oldTable: HashIntAnyArray; oldSize, i, key: LONGINT;
  148. BEGIN
  149. oldSize := size;
  150. oldTable := table;
  151. Init(size*2);
  152. FOR i := 0 TO oldSize-1 DO
  153. key := oldTable[i].key;
  154. IF key # 0 THEN
  155. Put(key, oldTable[i].value);
  156. END;
  157. END;
  158. END Grow;
  159. END HashTableIntAny;
  160. Data=RECORD size, pos: LONGINT; bytes: Modules.Bytes; firstAddress: LONGINT; END;
  161. Arrangement* = OBJECT (GenericLinker.Arrangement);
  162. VAR
  163. code, data: Data;
  164. (*moduleAdr: LONGINT;*)
  165. hasBody: BOOLEAN;
  166. bodyAddress : LONGINT;
  167. PROCEDURE & InitArrangement;
  168. BEGIN InitData(code); InitData(data); hasBody := FALSE;
  169. END InitArrangement;
  170. PROCEDURE Preallocate*(CONST section: ObjectFile.Section);
  171. BEGIN
  172. ASSERT(section.unit = 8);
  173. ASSERT(section.bits.GetSize() MOD 8 = 0);
  174. ASSERT(section.type # ObjectFile.InitCode);
  175. IF section.type IN {ObjectFile.Code, ObjectFile.BodyCode} THEN
  176. DoPreallocate(section, code);
  177. ELSE ASSERT (section.type IN {ObjectFile.Const, ObjectFile.Data});
  178. DoPreallocate(section, data);
  179. END;
  180. END Preallocate;
  181. PROCEDURE Allocate* (CONST section: ObjectFile.Section): GenericLinker.Address;
  182. VAR adr: GenericLinker.Address;
  183. BEGIN
  184. IF section.type IN {ObjectFile.Code, ObjectFile.BodyCode} THEN
  185. adr := DoAllocate(section, code);
  186. ELSE ASSERT(section.type IN {ObjectFile.Const, ObjectFile.Data});
  187. adr := DoAllocate(section, data);
  188. END;
  189. IF section.type = ObjectFile.BodyCode THEN
  190. hasBody := TRUE; bodyAddress := adr;
  191. END;
  192. (*
  193. IF (section.identifier.name[0] >= 0) & (section.identifier.name[1] >= 0) THEN
  194. IF (section.identifier.name[1] = InternalModuleName) OR (section.identifier.name[2] = InternalModuleName) THEN
  195. moduleAdr := adr
  196. END;
  197. END;
  198. *)
  199. RETURN adr;
  200. END Allocate;
  201. PROCEDURE Patch* (pos, value: GenericLinker.Address; offset, bits, unit: ObjectFile.Bits);
  202. VAR char: CHAR;
  203. BEGIN
  204. ASSERT(bits MOD 8 = 0);
  205. ASSERT(unit = 8);
  206. WHILE bits > 0 DO
  207. char := CHR(value);
  208. SYSTEM.PUT(pos, char);
  209. value := value DIV 256;
  210. DEC(bits,8); INC(pos,1);
  211. END;
  212. END Patch;
  213. END Arrangement;
  214. ModuleList=OBJECT
  215. VAR
  216. hash: HashTableIntAny;
  217. PROCEDURE &Init;
  218. BEGIN
  219. NEW(hash,128);
  220. END Init;
  221. PROCEDURE ThisModule(module: Modules.Module): HashTableInt;
  222. VAR modList: HashTableInt;
  223. any: ANY;
  224. PROCEDURE TraverseScopes(CONST scope: Modules.ExportDesc; level: LONGINT);
  225. VAR adr,i: LONGINT;
  226. BEGIN
  227. IF (level > 2) THEN RETURN END;
  228. IF (scope.fp # 0) THEN
  229. adr := scope.adr;
  230. IF SupportOldObjectFileFormat THEN
  231. IF module.staticTypeDescs # testTypeDescs THEN (* old object file format *)
  232. IF (adr = 0) & (scope.dsc # NIL) & (LEN(scope.dsc)>0) THEN (* type in old object file format *)
  233. adr := scope.dsc[0].adr;
  234. SYSTEM.GET(module.sb + adr, adr);
  235. ELSIF adr # 0 THEN
  236. INC(adr,ADDRESSOF(module.code[0]));
  237. END;
  238. END;
  239. END;
  240. modList.Put(scope.fp, adr)
  241. END;
  242. FOR i := 0 TO scope.exports-1 DO
  243. IF scope.dsc # NIL THEN TraverseScopes(scope.dsc[i],level+1) END;
  244. END;
  245. adr := 0;
  246. END TraverseScopes;
  247. BEGIN{EXCLUSIVE}
  248. IF hash.Has(SYSTEM.VAL(LONGINT, module)) THEN
  249. any := hash.Get(SYSTEM.VAL(LONGINT,module));
  250. modList := any(HashTableInt);
  251. ELSE
  252. NEW(modList,256); TraverseScopes(module.export,0);
  253. hash.Put(SYSTEM.VAL(LONGINT,module), modList);
  254. RETURN modList
  255. END;
  256. RETURN modList;
  257. END ThisModule;
  258. END ModuleList;
  259. Linker = OBJECT (GenericLinker.Linker)
  260. VAR
  261. moduleName: ObjectFile.SegmentedName;
  262. importBlock: GenericLinker.Block;
  263. hash: HashTableIntAny;
  264. moduleBlock: GenericLinker.Block;
  265. PROCEDURE &InitLinkerX* (diagnostics: Diagnostics.Diagnostics; log: Streams.Writer; code, data: GenericLinker.Arrangement; CONST name: ARRAY OF CHAR);
  266. BEGIN
  267. ObjectFile.StringToSegmentedName(name, moduleName);
  268. InitLinker(diagnostics, log, GenericLinker.UseAllButInitCode (* strip init code *), code, data);
  269. NEW(importBlock);
  270. NEW(hash,256); (* hash for blocks *)
  271. END InitLinkerX;
  272. (* oerwritten functionality of generic linker *)
  273. PROCEDURE FindBlock(CONST identifier: ObjectFile.Identifier): GenericLinker.Block;
  274. VAR block: GenericLinker.Block; any: ANY;
  275. BEGIN
  276. block := NIL;
  277. IF IsPrefix(moduleName, identifier.name) THEN (* local block *)
  278. IF identifier.fingerprint = 0 THEN (* not identifiable via fingerprint *)
  279. block := FindBlock^(identifier);
  280. ELSE
  281. any := hash.Get(identifier.fingerprint);
  282. IF any # NIL THEN block := any(GenericLinker.Block) (* local block *) END;
  283. IF (block # NIL) & (block.identifier.name # identifier.name) THEN (* local block, false or duplicate fingerprint *)
  284. block := FindBlock^(identifier)
  285. END;
  286. END;
  287. END;
  288. RETURN block;
  289. END FindBlock;
  290. PROCEDURE ExportBlock(block: GenericLinker.Block);
  291. BEGIN
  292. IF block.identifier.fingerprint # 0 THEN
  293. hash.Put(block.identifier.fingerprint, block)
  294. END;
  295. IF (block.identifier.name[0] >= 0) & (block.identifier.name[1] >= 0) THEN
  296. IF (block.identifier.name[1] = InternalModuleName) & (block.identifier.name[2]<0) OR (block.identifier.name[2] = InternalModuleName) & (block.identifier.name[3] < 0) THEN
  297. moduleBlock := block;
  298. END;
  299. END;
  300. END ExportBlock;
  301. PROCEDURE ImportBlock(CONST fixup: ObjectFile.Fixup): GenericLinker.Block;
  302. VAR name: Modules.Name; res: LONGINT;
  303. msg: ARRAY 128 OF CHAR; module: Modules.Module; adr: LONGINT; m: HashTableInt;
  304. s: ObjectFile.SectionName; isModule: BOOLEAN; identifier: ObjectFile.Identifier;
  305. PROCEDURE CheckName(n: StringPool.Index; name {UNTRACED}: POINTER {UNSAFE} TO ARRAY OF CHAR): LONGINT;
  306. VAR s: ObjectFile.SectionName; i: LONGINT;
  307. BEGIN
  308. IF name = NIL THEN RETURN -1 END;
  309. StringPool.GetString(n, s);
  310. i := 0;
  311. WHILE (s[i] # 0X) & (name[i] # 0X) & (s[i] = name[i]) DO
  312. INC(i);
  313. END;
  314. RETURN ORD(s[i]) - ORD(name[i]);
  315. END CheckName;
  316. (* stupid implementation: just search for fp in all exports *)
  317. PROCEDURE CheckScope(CONST scope: Modules.ExportDesc; level: LONGINT): LONGINT;
  318. VAR adr,i,lo,hi,m,res: LONGINT;
  319. BEGIN
  320. adr := 0;
  321. (* export names are sorted, binary search: *)
  322. lo := 0; hi := scope.exports-1;
  323. WHILE (lo <= hi) DO
  324. m := (lo + hi) DIV 2;
  325. res := CheckName(identifier.name[level], scope.dsc[m].name);
  326. IF res = 0 THEN
  327. IF (level = LEN(identifier.name)-1) OR (identifier.name[level+1] <= 0) THEN
  328. IF (scope.dsc[m].fp # identifier.fingerprint) & (scope.dsc[m].fp # 0) & (identifier.fingerprint # 0) THEN
  329. TRACE("fingerprints don't match");
  330. END;
  331. RETURN scope.dsc[m].adr
  332. ELSE
  333. RETURN CheckScope(scope.dsc[m], level+1);
  334. END;
  335. ELSIF res > 0 THEN lo := m+1;
  336. ELSE hi := m-1;
  337. END;
  338. END;
  339. RETURN 0;
  340. END CheckScope;
  341. BEGIN
  342. identifier := fixup.identifier;
  343. IF IsPrefix(moduleName, identifier.name) THEN
  344. D.String("circular import while trying to fetch ");
  345. s := identifier.name; D.String(s);
  346. D.Ln;
  347. RETURN NIL
  348. END;
  349. StringPool.GetString(identifier.name[0], name);
  350. isModule := identifier.name[1] = InternalModuleName;
  351. IF (identifier.name[0] = OberonName) & (identifier.name[2] >= 0) THEN (* in Oberon name space *)
  352. StringPool.GetString(identifier.name[1], s);
  353. Strings.Append(name, ".");
  354. Strings.Append(name, s);
  355. isModule := identifier.name[2] = InternalModuleName;
  356. END;
  357. (*
  358. IF ~isModule & (identifier.fingerprint = 0) THEN
  359. D.String("Invalid attempt to import symbol without fingerprint ");
  360. s := identifier.name; D.String(s);
  361. D.Ln;
  362. RETURN NIL
  363. END;
  364. *)
  365. module := Modules.ThisModule(name,res,msg);
  366. IF module = NIL THEN
  367. D.String("could not get module while importing "); D.String(name); D.Ln;
  368. RETURN NIL
  369. END;
  370. IF isModule THEN
  371. adr := SYSTEM.VAL(ADDRESS, module) - fixup.patch[0].displacement;
  372. ELSE
  373. m := moduleList.ThisModule(module);
  374. ASSERT(module # NIL);
  375. (* first try via hash-table *)
  376. (* disabled -- might be able to remove hash table completely, needs some testing
  377. IF identifier.fingerprint # 0 THEN
  378. adr := m.Get(identifier.fingerprint);
  379. END;
  380. *)
  381. (* if it does not work, then try export table directly *)
  382. IF adr = 0 THEN
  383. adr := CheckScope(module.export,1(*level*) );
  384. END;
  385. END;
  386. IF adr = 0 THEN
  387. D.String("GenericLoader Fatal error: did not find block "); s := identifier.name; D.String(s); D.Ln;
  388. RETURN NIL;
  389. ELSE (* found *)
  390. importBlock.identifier.fingerprint := identifier.fingerprint; importBlock.address := adr
  391. END;
  392. RETURN importBlock
  393. END ImportBlock;
  394. END Linker;
  395. VAR
  396. moduleList: ModuleList;
  397. testTypeDescs: Modules.Bytes;
  398. InternalModuleName, OberonName: StringPool.Index;
  399. PROCEDURE InitData(VAR data: Data);
  400. BEGIN
  401. data.pos := 0; data.size := 0; data.bytes := NIL; data.firstAddress := 0;
  402. END InitData;
  403. PROCEDURE IsPrefix(CONST prefix, of: ObjectFile.SegmentedName): BOOLEAN;
  404. VAR prefixS, ofS: ObjectFile.SectionName; i: LONGINT;
  405. BEGIN
  406. i := 0;
  407. WHILE (i< LEN(prefix)) & (prefix[i] = of[i]) DO INC(i) END;
  408. IF i = LEN(prefix) THEN RETURN TRUE (* identical *)
  409. ELSE (* prefix[i] # of[i] *)
  410. IF prefix[i] < 0 THEN RETURN TRUE (* name longer than prefix *)
  411. ELSIF of[i] < 0 THEN RETURN FALSE (* prefix longer than name *)
  412. ELSIF (i<LEN(prefix)-1) THEN RETURN FALSE (* prefix and name differ but not at the tail *)
  413. ELSE
  414. (* check tail *)
  415. StringPool.GetString(prefix[i], prefixS);
  416. StringPool.GetString(of[i], ofS);
  417. RETURN Strings.StartsWith(prefixS, 0, ofS)
  418. END
  419. END;
  420. END IsPrefix;
  421. PROCEDURE DoPreallocate(CONST section: ObjectFile.Section; VAR data: Data);
  422. BEGIN
  423. ASSERT(section.bits.GetSize() MOD 8 = 0);
  424. IF section.alignment > 0 THEN
  425. INC(data.size, (-data.size) MOD section.alignment); (* here we assume that base-alignment is ok *)
  426. END;
  427. INC(data.size, section.bits.GetSize() DIV 8);
  428. END DoPreallocate;
  429. PROCEDURE DoAllocate(CONST section: ObjectFile.Section; VAR data: Data): GenericLinker.Address;
  430. VAR address: ObjectFile.Bits; bitPos, size, value: LONGINT;
  431. BEGIN
  432. IF (data.bytes = NIL) OR (LEN(data.bytes) # data.size) THEN NEW(data.bytes, data.size) END;
  433. IF section.alignment > 0 THEN
  434. INC(data.pos, (-data.pos) MOD section.alignment); (* here we assume that base-alignment is ok *)
  435. END;
  436. address := ADDRESSOF(data.bytes[0])+data.pos; (* to account for potentially empty variable at end of data ... *)
  437. size := section.bits.GetSize();
  438. section.bits.CopyTo(address, size);
  439. INC(data.pos, size DIV 8);
  440. (*
  441. bitPos:= 0;
  442. WHILE size > 0 DO
  443. value := section.bits.GetBits(bitPos,8);
  444. data.bytes[data.pos] := CHR(value);
  445. DEC(size,8); INC(data.pos); INC(bitPos,8);
  446. END;
  447. *)
  448. IF data.firstAddress = 0 THEN data.firstAddress := address END;
  449. RETURN address
  450. END DoAllocate;
  451. PROCEDURE SortProcTable(m: Modules.Module);
  452. VAR i, j, min : LONGINT;
  453. PROCEDURE Max(a,b: LONGINT): LONGINT;
  454. BEGIN
  455. IF a > b THEN RETURN a ELSE RETURN b END;
  456. END Max;
  457. PROCEDURE SwapProcTableEntries(p, q : LONGINT);
  458. VAR procentry : Modules.ProcTableEntry;
  459. k, i, basep, baseq: LONGINT; ptr: SIZE;
  460. BEGIN
  461. k := Max(m.procTable[p].noPtr, m.procTable[q].noPtr);
  462. IF k > 0 THEN (* swap entries in ptrTable first *)
  463. basep := p * m.maxPtrs; baseq := q * m.maxPtrs;
  464. FOR i := 0 TO k - 1 DO
  465. ptr := m.ptrTable[basep + i];
  466. m.ptrTable[basep + i] := m.ptrTable[baseq + i];
  467. m.ptrTable[baseq + i] := ptr
  468. END
  469. END;
  470. procentry := m.procTable[p];
  471. m.procTable[p] := m.procTable[q];
  472. m.procTable[q] := procentry
  473. END SwapProcTableEntries;
  474. PROCEDURE NormalizePointerArray;
  475. VAR ptrTable: Modules.PtrTable; i,j,k: LONGINT;
  476. BEGIN
  477. NEW(ptrTable, m.maxPtrs*m.noProcs);
  478. k := 0;
  479. FOR i := 0 TO LEN(m.procTable)-1 DO
  480. FOR j := 0 TO m.procTable[i].noPtr-1 DO
  481. ptrTable[i*m.maxPtrs+j] := m.ptrTable[k];
  482. INC(k);
  483. END;
  484. END;
  485. m.ptrTable := ptrTable;
  486. END NormalizePointerArray;
  487. BEGIN
  488. NormalizePointerArray;
  489. FOR i := 0 TO m.noProcs - 2 DO
  490. min := i;
  491. FOR j := i + 1 TO m.noProcs - 1 DO
  492. IF m.procTable[j].pcFrom < m.procTable[min].pcFrom THEN min:= j END
  493. END;
  494. IF min # i THEN SwapProcTableEntries(i, min) END
  495. END
  496. END SortProcTable;
  497. PROCEDURE SelectionSort(exTable: Modules.ExceptionTable);
  498. VAR
  499. p, q, min: LONGINT;
  500. entry: Modules.ExceptionTableEntry;
  501. BEGIN
  502. FOR p := 0 TO LEN(exTable) - 2 DO
  503. min := p;
  504. FOR q := p + 1 TO LEN(exTable) - 1 DO
  505. IF exTable[min].pcFrom > exTable[q].pcFrom THEN min := q END;
  506. entry := exTable[min]; exTable[min] := exTable[p]; exTable[p] := entry;
  507. END
  508. END
  509. END SelectionSort;
  510. PROCEDURE LoadObj*(CONST name, fileName: ARRAY OF CHAR; VAR res: LONGINT; VAR msg: ARRAY OF CHAR): Modules.Module;
  511. TYPE Body=PROCEDURE;
  512. VAR
  513. file: Files.File; reader: Files.Reader; linker: Linker;
  514. arrangement: Arrangement; diagnostics: Diagnostics.StreamDiagnostics; stringWriter: Streams.StringWriter;
  515. module: Modules.Module; heapBlockAdr,moduleAdr: LONGINT;
  516. Log: Streams.Writer;
  517. BEGIN
  518. file := Files.Old(fileName);
  519. IF file # NIL THEN
  520. IF TraceLoading THEN Trace.String("loading"); Trace.String(fileName); Trace.Ln END;
  521. res := Ok; msg[0] := 0X;
  522. Files.OpenReader(reader, file, 0);
  523. NEW(arrangement); NEW(stringWriter,256);
  524. Streams.OpenWriter( Log, KernelLog.Send );
  525. NEW(diagnostics,Log);
  526. NEW(linker, diagnostics, NIL, arrangement, arrangement,name);
  527. IF TraceLoading THEN Trace.String("before linking"); Trace.Ln END;
  528. GenericLinker.Process (reader, linker);
  529. IF ~linker.error THEN linker.Resolve END;
  530. IF ~linker.error THEN linker.Link END;
  531. (*D.Update;*)
  532. IF ~linker.error THEN
  533. IF TraceLoading THEN Trace.String("linking done"); Trace.Ln END;
  534. moduleAdr := linker.moduleBlock.address;
  535. IF ~Machine.IsCooperative THEN
  536. SYSTEM.GET(moduleAdr+3*SIZEOF(ADDRESS), moduleAdr);
  537. SYSTEM.GET(moduleAdr-2*SIZEOF(ADDRESS), heapBlockAdr);
  538. ASSERT(heapBlockAdr = linker.moduleBlock.address+2*SIZEOF(ADDRESS));
  539. END;
  540. module := SYSTEM.VAL(Modules.Module,moduleAdr);
  541. module.staticTypeDescs := testTypeDescs; (* trick to identify new object file loaded modules *)
  542. module.data := arrangement.data.bytes;
  543. module.code := arrangement.code.bytes;
  544. module.firstProc := arrangement.code.firstAddress;
  545. module.sb := arrangement.data.firstAddress;
  546. module.body := SYSTEM.VAL(Body, arrangement.bodyAddress);
  547. (*
  548. SortProcTable(module);
  549. SelectionSort(module.exTable);
  550. *)
  551. ELSE module := NIL; res := LinkerError; stringWriter.Update; stringWriter.Get(msg);
  552. END;
  553. ELSE
  554. res := FileNotFound; COPY(fileName, msg); Modules.Append(" not found", msg)
  555. END;
  556. IF res # Ok THEN module := NIL END;
  557. IF (res # Ok) & (res # FileNotFound) THEN D.String(msg);D.Ln END;
  558. RETURN module
  559. FINALLY
  560. RETURN NIL
  561. END LoadObj;
  562. PROCEDURE Install*;
  563. VAR extension: ARRAY 32 OF CHAR;
  564. BEGIN
  565. Machine.GetConfig("ObjectFileExtension", extension);
  566. IF extension = "" THEN
  567. COPY(".Gof", extension)
  568. END;
  569. Modules.AddLoader(extension, LoadObj);
  570. END Install;
  571. PROCEDURE Remove*;
  572. BEGIN
  573. Modules.RemoveLoader(".Gof",LoadObj);
  574. END Remove;
  575. BEGIN
  576. NEW(testTypeDescs,1);
  577. Modules.InstallTermHandler(Remove);
  578. StringPool.GetIndex("Oberon",OberonName);
  579. StringPool.GetIndex("@Module",InternalModuleName);
  580. NEW(moduleList);
  581. Install;
  582. END GenericLoader.
  583. (* concurrent load test:
  584. VAR
  585. startConcurrentLoad: BOOLEAN;
  586. PROCEDURE ConcurrentLoad*;
  587. VAR i: LONGINT;
  588. o: OBJECT VAR
  589. mod: Modules.Module; res: LONGINT; msg: ARRAY 32 OF CHAR;
  590. BEGIN{ACTIVE}
  591. WHILE(~startConcurrentLoad) DO END;
  592. mod := Modules.ThisModule("Test",res,msg);
  593. END;
  594. BEGIN
  595. startConcurrentLoad := FALSE;
  596. FOR i := 0 TO 128 DO
  597. NEW(o);
  598. END;
  599. startConcurrentLoad := TRUE;
  600. END ConcurrentLoad;
  601. *)