GenericLoader.Mod 20 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705
  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}: Modules.DynamicName): 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 := 0 (*arrangement.data.firstAddress*); (* zero is correct ! *)
  546. module.body := SYSTEM.VAL(Body, arrangement.bodyAddress);
  547. (*
  548. SortProcTable(module);
  549. SelectionSort(module.exTable);
  550. *)
  551. (*
  552. careful: when GC uses a heuristic for pointer detection on the stack, it will not
  553. trace the module because the module is not reachable as a heap block in a sweep
  554. Therefore the code and data array has to be secured in addition.
  555. Here this is made sure to enter the module in the data structure before returning it.
  556. *)
  557. Modules.Initialize(module);
  558. ELSE module := NIL; res := LinkerError; stringWriter.Update; stringWriter.Get(msg);
  559. END;
  560. ELSE
  561. res := FileNotFound; COPY(fileName, msg); Modules.Append(" not found", msg)
  562. END;
  563. IF res # Ok THEN module := NIL END;
  564. IF (res # Ok) & (res # FileNotFound) THEN D.String(msg);D.Ln END;
  565. RETURN module
  566. FINALLY
  567. RETURN NIL
  568. END LoadObj;
  569. PROCEDURE Install*;
  570. VAR extension: ARRAY 32 OF CHAR;
  571. BEGIN
  572. Machine.GetConfig("ObjectFileExtension", extension);
  573. IF extension = "" THEN
  574. COPY(".Gof", extension)
  575. END;
  576. Modules.AddLoader(extension, LoadObj);
  577. END Install;
  578. PROCEDURE Remove*;
  579. BEGIN
  580. Modules.RemoveLoader(".Gof",LoadObj);
  581. END Remove;
  582. BEGIN
  583. NEW(testTypeDescs,1);
  584. Modules.InstallTermHandler(Remove);
  585. StringPool.GetIndex("Oberon",OberonName);
  586. StringPool.GetIndex("@Module",InternalModuleName);
  587. NEW(moduleList);
  588. Install;
  589. END GenericLoader.
  590. (* concurrent load test:
  591. VAR
  592. startConcurrentLoad: BOOLEAN;
  593. PROCEDURE ConcurrentLoad*;
  594. VAR i: LONGINT;
  595. o: OBJECT VAR
  596. mod: Modules.Module; res: LONGINT; msg: ARRAY 32 OF CHAR;
  597. BEGIN{ACTIVE}
  598. WHILE(~startConcurrentLoad) DO END;
  599. mod := Modules.ThisModule("Test",res,msg);
  600. END;
  601. BEGIN
  602. startConcurrentLoad := FALSE;
  603. FOR i := 0 TO 128 DO
  604. NEW(o);
  605. END;
  606. startConcurrentLoad := TRUE;
  607. END ConcurrentLoad;
  608. *)