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.exports > 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. (*
  452. PROCEDURE SortProcTable(m: Modules.Module);
  453. VAR i, j, min : LONGINT;
  454. PROCEDURE Max(a,b: LONGINT): LONGINT;
  455. BEGIN
  456. IF a > b THEN RETURN a ELSE RETURN b END;
  457. END Max;
  458. PROCEDURE SwapProcTableEntries(p, q : LONGINT);
  459. VAR procentry : Modules.ProcTableEntry;
  460. k, i, basep, baseq: LONGINT; ptr: SIZE;
  461. BEGIN
  462. k := Max(m.procTable[p].noPtr, m.procTable[q].noPtr);
  463. IF k > 0 THEN (* swap entries in ptrTable first *)
  464. basep := p * m.maxPtrs; baseq := q * m.maxPtrs;
  465. FOR i := 0 TO k - 1 DO
  466. ptr := m.ptrTable[basep + i];
  467. m.ptrTable[basep + i] := m.ptrTable[baseq + i];
  468. m.ptrTable[baseq + i] := ptr
  469. END
  470. END;
  471. procentry := m.procTable[p];
  472. m.procTable[p] := m.procTable[q];
  473. m.procTable[q] := procentry
  474. END SwapProcTableEntries;
  475. PROCEDURE NormalizePointerArray;
  476. VAR ptrTable: Modules.PtrTable; i,j,k: LONGINT;
  477. BEGIN
  478. NEW(ptrTable, m.maxPtrs*m.noProcs);
  479. k := 0;
  480. FOR i := 0 TO LEN(m.procTable)-1 DO
  481. FOR j := 0 TO m.procTable[i].noPtr-1 DO
  482. ptrTable[i*m.maxPtrs+j] := m.ptrTable[k];
  483. INC(k);
  484. END;
  485. END;
  486. m.ptrTable := ptrTable;
  487. END NormalizePointerArray;
  488. BEGIN
  489. NormalizePointerArray;
  490. FOR i := 0 TO m.noProcs - 2 DO
  491. min := i;
  492. FOR j := i + 1 TO m.noProcs - 1 DO
  493. IF m.procTable[j].pcFrom < m.procTable[min].pcFrom THEN min:= j END
  494. END;
  495. IF min # i THEN SwapProcTableEntries(i, min) END
  496. END
  497. END SortProcTable;
  498. *)
  499. PROCEDURE SelectionSort(exTable: Modules.ExceptionTable);
  500. VAR
  501. p, q, min: LONGINT;
  502. entry: Modules.ExceptionTableEntry;
  503. BEGIN
  504. FOR p := 0 TO LEN(exTable) - 2 DO
  505. min := p;
  506. FOR q := p + 1 TO LEN(exTable) - 1 DO
  507. IF exTable[min].pcFrom > exTable[q].pcFrom THEN min := q END;
  508. entry := exTable[min]; exTable[min] := exTable[p]; exTable[p] := entry;
  509. END
  510. END
  511. END SelectionSort;
  512. PROCEDURE LoadObj*(CONST name, fileName: ARRAY OF CHAR; VAR res: LONGINT; VAR msg: ARRAY OF CHAR): Modules.Module;
  513. TYPE Body=PROCEDURE;
  514. VAR
  515. file: Files.File; reader: Files.Reader; linker: Linker;
  516. arrangement: Arrangement; diagnostics: Diagnostics.StreamDiagnostics; stringWriter: Streams.StringWriter;
  517. module: Modules.Module; heapBlockAdr,moduleAdr: LONGINT;
  518. Log: Streams.Writer;
  519. BEGIN
  520. file := Files.Old(fileName);
  521. IF file # NIL THEN
  522. IF TraceLoading THEN Trace.String("loading"); Trace.String(fileName); Trace.Ln END;
  523. res := Ok; msg[0] := 0X;
  524. Files.OpenReader(reader, file, 0);
  525. NEW(arrangement); NEW(stringWriter,256);
  526. Streams.OpenWriter( Log, KernelLog.Send );
  527. NEW(diagnostics,Log);
  528. NEW(linker, diagnostics, NIL, arrangement, arrangement,name);
  529. IF TraceLoading THEN Trace.String("before linking"); Trace.Ln END;
  530. GenericLinker.Process (reader, linker);
  531. IF ~linker.error THEN linker.Resolve END;
  532. IF ~linker.error THEN linker.Link END;
  533. (*D.Update;*)
  534. IF ~linker.error THEN
  535. IF TraceLoading THEN Trace.String("linking done"); Trace.Ln END;
  536. moduleAdr := linker.moduleBlock.address;
  537. IF ~Machine.IsCooperative THEN
  538. SYSTEM.GET(moduleAdr+3*SIZEOF(ADDRESS), moduleAdr);
  539. SYSTEM.GET(moduleAdr-2*SIZEOF(ADDRESS), heapBlockAdr);
  540. ASSERT(heapBlockAdr = linker.moduleBlock.address+2*SIZEOF(ADDRESS));
  541. END;
  542. module := SYSTEM.VAL(Modules.Module,moduleAdr);
  543. module.staticTypeDescs := testTypeDescs; (* trick to identify new object file loaded modules *)
  544. module.data := arrangement.data.bytes;
  545. module.code := arrangement.code.bytes;
  546. module.sb := 0 (*arrangement.data.firstAddress*); (* zero is correct ! *)
  547. module.body := SYSTEM.VAL(Body, arrangement.bodyAddress);
  548. (*
  549. SortProcTable(module);
  550. SelectionSort(module.exTable);
  551. *)
  552. (*
  553. careful: when GC uses a heuristic for pointer detection on the stack, it will not
  554. trace the module because the module is not reachable as a heap block in a sweep
  555. Therefore the code and data array has to be secured in addition.
  556. Here this is made sure to enter the module in the data structure before returning it.
  557. *)
  558. Modules.Initialize(module);
  559. ELSE module := NIL; res := LinkerError; stringWriter.Update; stringWriter.Get(msg);
  560. END;
  561. ELSE
  562. res := FileNotFound; COPY(fileName, msg); Modules.Append(" not found", msg)
  563. END;
  564. IF res # Ok THEN module := NIL END;
  565. IF (res # Ok) & (res # FileNotFound) THEN D.String(msg);D.Ln END;
  566. RETURN module
  567. FINALLY
  568. RETURN NIL
  569. END LoadObj;
  570. PROCEDURE Install*;
  571. VAR extension: ARRAY 32 OF CHAR;
  572. BEGIN
  573. Machine.GetConfig("ObjectFileExtension", extension);
  574. IF extension = "" THEN
  575. COPY(".Gof", extension)
  576. END;
  577. Modules.AddLoader(extension, LoadObj);
  578. END Install;
  579. PROCEDURE Remove*;
  580. BEGIN
  581. Modules.RemoveLoader(".Gof",LoadObj);
  582. END Remove;
  583. BEGIN
  584. NEW(testTypeDescs,1);
  585. Modules.InstallTermHandler(Remove);
  586. StringPool.GetIndex("Oberon",OberonName);
  587. StringPool.GetIndex("@Module",InternalModuleName);
  588. NEW(moduleList);
  589. Install;
  590. END GenericLoader.
  591. (* concurrent load test:
  592. VAR
  593. startConcurrentLoad: BOOLEAN;
  594. PROCEDURE ConcurrentLoad*;
  595. VAR i: LONGINT;
  596. o: OBJECT VAR
  597. mod: Modules.Module; res: LONGINT; msg: ARRAY 32 OF CHAR;
  598. BEGIN{ACTIVE}
  599. WHILE(~startConcurrentLoad) DO END;
  600. mod := Modules.ThisModule("Test",res,msg);
  601. END;
  602. BEGIN
  603. startConcurrentLoad := FALSE;
  604. FOR i := 0 TO 128 DO
  605. NEW(o);
  606. END;
  607. startConcurrentLoad := TRUE;
  608. END ConcurrentLoad;
  609. *)