2
0

ObjectFile.Mod 39 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389
  1. MODULE ObjectFile; (* AUTHOR "negelef"; PURPOSE "Generic Object File Representation"; *)
  2. IMPORT Streams, BitSets, StringPool;
  3. CONST
  4. (* Fixup modes *)
  5. Absolute* = 0;
  6. Relative* = 1;
  7. (* Section categories *)
  8. (* code section categories, ordered by decreasing linking preference *)
  9. EntryCode*= 0; (* entry code sections provide the entry point for static linking, enry code runs before module initializer callers *)
  10. InitCode*=1; (* initcode sections provide the entry point for static linking. A static linker includes this sections, a dynamic linker wants to omit them *)
  11. ExitCode*=2; (* exit code sections close a statically linked code, are executed after all init code callers *)
  12. BodyCode*=3; (* body code sections provide the entry point for dynamic linking. A dynamic linker needs to be able to distinguish them from normal code *)
  13. Code*=4; (* normal executable code *)
  14. (* data section categories *)
  15. Data* = 5; (* data sections provide space for (global) variables *)
  16. Const* = 6; (* const sections are data sections that are immutable *)
  17. (* alignment types *)
  18. Aligned=0;
  19. Fixed=1;
  20. DefaultExtension* = ".Gof";
  21. SegmentedNameLength=8;
  22. TYPE
  23. Unit* = LONGINT;
  24. Bits* = LONGINT;
  25. SectionType = INTEGER;
  26. SegmentedName*= ARRAY SegmentedNameLength OF StringPool.Index;
  27. SectionName* = ARRAY 128 OF CHAR;
  28. (* FixupPattern = size (+|-) bits {size (+|-) bits}
  29. Example:
  30. fixupPattern = 0+8 -128+4 8-8 means
  31. store first 8 bits to offset 0
  32. leave out next 4 bits
  33. store next 8 bits to offset 8 in reverse order
  34. most frequently used are
  35. fixupPattern=0+8 : 8 bit fixup
  36. fixupPattern=0+16: 16 bit fixup
  37. fixupPattern=0+32: 32 bit fixup
  38. *)
  39. FixupPattern* = RECORD
  40. offset*, bits*: Bits;
  41. END;
  42. FixupPatterns*= POINTER TO ARRAY OF FixupPattern;
  43. Identifier*= RECORD
  44. name*: SegmentedName;
  45. fingerprint*: LONGINT;
  46. END;
  47. Pattern*= POINTER TO RECORD (* this is the same for many fixups *)
  48. mode-: INTEGER;
  49. scale-: Bits;
  50. patterns-: LONGINT;
  51. pattern-: FixupPatterns
  52. END;
  53. Patch*= RECORD
  54. offset-, displacement-: Unit;
  55. END;
  56. Patches*= POINTER TO ARRAY OF Patch;
  57. Fixup* = RECORD
  58. identifier*: Identifier;
  59. pattern-: Pattern;
  60. index*: LONGINT;
  61. patches*: LONGINT;
  62. patch*: Patches;
  63. END;
  64. Alias*= RECORD
  65. identifier*: Identifier;
  66. offset-: Unit
  67. END;
  68. Fixups*=POINTER TO ARRAY OF Fixup;
  69. Aliases*= POINTER TO ARRAY OF Alias;
  70. Section* = RECORD
  71. type*: SectionType;
  72. identifier*: Identifier;
  73. unit*: Bits;
  74. fixed*: BOOLEAN;
  75. alignment*: Unit;
  76. fixups-: LONGINT;
  77. fixup-: Fixups;
  78. aliases-: LONGINT;
  79. alias-: Aliases;
  80. bits*: BitSets.BitSet;
  81. END;
  82. PoolMapItem= RECORD key, value: LONGINT END;
  83. PoolMapArray*=POINTER TO ARRAY OF PoolMapItem;
  84. PoolMap*=OBJECT
  85. VAR
  86. table: PoolMapArray;
  87. size: LONGINT;
  88. used: LONGINT;
  89. maxLoadFactor: REAL;
  90. writer: Streams.Writer;
  91. (* Interface *)
  92. PROCEDURE & Init* (initialSize: LONGINT);
  93. BEGIN
  94. ASSERT(initialSize > 2);
  95. NEW(table, initialSize);
  96. size := initialSize;
  97. used := 0;
  98. maxLoadFactor := 0.75;
  99. Clear;
  100. Put(0,0); (* empty string mapped one-to-one *)
  101. END Init;
  102. PROCEDURE Put(key, value: LONGINT);
  103. VAR hash: LONGINT;
  104. BEGIN
  105. ASSERT(used < size);
  106. ASSERT(key >= 0);
  107. hash := HashValue(key);
  108. IF table[hash].key <0 THEN
  109. INC(used, 1);
  110. table[hash].key := key;
  111. ELSE
  112. ASSERT(table[hash].key = key);
  113. END;
  114. table[hash].value := value;
  115. IF (used / size) > maxLoadFactor THEN Grow END;
  116. END Put;
  117. PROCEDURE Get*(key: LONGINT):LONGINT;
  118. BEGIN
  119. IF key = -1 THEN
  120. RETURN -1
  121. ELSE
  122. RETURN table[HashValue(key)].value;
  123. END
  124. END Get;
  125. PROCEDURE Has*(key: LONGINT):BOOLEAN;
  126. BEGIN
  127. RETURN table[HashValue(key)].key = key;
  128. END Has;
  129. PROCEDURE Clear*;
  130. VAR i: LONGINT;
  131. BEGIN FOR i := 0 TO size - 1 DO table[i].key := -1; END; END Clear;
  132. (* only correctly working, if NIL key cannot be entered *)
  133. PROCEDURE HashValue(key: LONGINT):LONGINT;
  134. VAR value, h, i: LONGINT;
  135. BEGIN
  136. value := key;
  137. i := 0;
  138. h := value MOD size;
  139. REPEAT
  140. value := (h + i) 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: PoolMapArray; oldSize, i: LONGINT; 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. (** read map and produce Local --> Global **)
  160. PROCEDURE Read*(reader: Streams.Reader);
  161. VAR value,pos: LONGINT; name: SectionName;
  162. BEGIN
  163. pos := 1;
  164. reader.RawString(name);
  165. WHILE name[0] # 0X DO
  166. StringPool.GetIndex(name,value);
  167. Put(pos,value);
  168. INC(pos);
  169. reader.RawString(name);
  170. END;
  171. END Read;
  172. (** write global --> local map **)
  173. PROCEDURE PutGlobal*(key: LONGINT);
  174. VAR name: SectionName;
  175. BEGIN
  176. IF ~Has(key) THEN
  177. Put(key, used);
  178. StringPool.GetString(key, name);
  179. writer.RawString(name);
  180. END;
  181. END PutGlobal;
  182. PROCEDURE PutSegmentedName*(CONST name: SegmentedName);
  183. VAR i: LONGINT;
  184. BEGIN
  185. FOR i := 0 TO LEN(name)-1 DO
  186. IF name[i] < 0 THEN RETURN END;
  187. PutGlobal(name[i]);
  188. END;
  189. END PutSegmentedName;
  190. PROCEDURE BeginWriting*(w: Streams.Writer);
  191. BEGIN
  192. writer := w;
  193. END BeginWriting;
  194. PROCEDURE EndWriting*;
  195. BEGIN
  196. writer.RawString("");
  197. writer := NIL;
  198. END EndWriting;
  199. END PoolMap;
  200. NameList*= POINTER TO ARRAY OF SegmentedName;
  201. VAR
  202. categories: ARRAY 8 OF ARRAY 10 OF CHAR;
  203. modes: ARRAY 2 OF ARRAY 4 OF CHAR;
  204. relocatabilities: ARRAY 2 OF ARRAY 8 OF CHAR;
  205. statHeaders, statHeadersSize: LONGINT;
  206. statFixups, statFixupsSize, statFixupPatterns, statFixupPatches: LONGINT;
  207. statAliases, statAliasesSize: LONGINT;
  208. statSegments, statSegmentsSize: LONGINT;
  209. statCodeSections, statCodeSectionsSize: LONGINT;
  210. statDataSections, statDataSectionsSize: LONGINT;
  211. statConstSections, statConstSectionsSize: LONGINT;
  212. statInitSections, statInitSectionsSize: LONGINT;
  213. statBodySections, statBodySectionsSize: LONGINT;
  214. statSections, statSectionsTotalSize: LONGINT;
  215. PROCEDURE IsCode* (type: SectionType): BOOLEAN;
  216. BEGIN RETURN (type IN {EntryCode .. Code})
  217. END IsCode;
  218. PROCEDURE Matches*(CONST this, that: Identifier): BOOLEAN;
  219. BEGIN
  220. IF (this.fingerprint # 0) & (this.fingerprint = that.fingerprint) THEN RETURN TRUE
  221. ELSE RETURN (this.name = that.name)
  222. END;
  223. END Matches;
  224. PROCEDURE CopyIdentifier(CONST source: Identifier; VAR dest: Identifier);
  225. BEGIN
  226. dest.name := source.name; dest.fingerprint := source.fingerprint
  227. END CopyIdentifier;
  228. PROCEDURE CopyPattern( source: Pattern; VAR dest: Pattern);
  229. VAR i: LONGINT;
  230. BEGIN
  231. NEW(dest);
  232. dest.mode := source.mode;
  233. dest.scale := source.scale;
  234. dest.patterns := source.patterns;
  235. NEW(dest.pattern, dest.patterns);
  236. FOR i := 0 TO LEN(dest.pattern)-1 DO
  237. dest.pattern[i] := source.pattern[i];
  238. END;
  239. END CopyPattern;
  240. PROCEDURE CopyPatches(sourcePatches: LONGINT; source: Patches; VAR destPatches: LONGINT; VAR dest: Patches);
  241. VAR i: LONGINT;
  242. BEGIN
  243. destPatches := sourcePatches;
  244. NEW(dest, destPatches);
  245. FOR i := 0 TO destPatches-1 DO
  246. dest[i] := source[i]
  247. END;
  248. END CopyPatches;
  249. PROCEDURE CopyFixup*(source: Fixup; VAR dest: Fixup);
  250. BEGIN
  251. CopyIdentifier(source.identifier, dest.identifier);
  252. CopyPattern(source.pattern, dest.pattern);
  253. CopyPatches(source.patches, source.patch, dest.patches, dest.patch);
  254. END CopyFixup;
  255. PROCEDURE CopyAlias*(CONST source: Alias; VAR dest: Alias);
  256. BEGIN
  257. CopyIdentifier(source.identifier, dest.identifier);
  258. dest.offset := source.offset;
  259. END CopyAlias;
  260. PROCEDURE CopySection* (CONST source: Section; VAR dest: Section);
  261. VAR i: LONGINT;
  262. BEGIN
  263. dest.type := source.type;
  264. dest.identifier := source.identifier;
  265. dest.unit := source.unit;
  266. dest.fixed := source.fixed;
  267. dest.alignment := source.alignment;
  268. dest.fixups:= source.fixups;
  269. dest.aliases := source.aliases;
  270. NEW (dest.fixup, dest.fixups);
  271. FOR i := 0 TO dest.fixups - 1 DO
  272. CopyFixup(source.fixup[i], dest.fixup[i]);
  273. END;
  274. NEW (dest.alias, dest.aliases);
  275. FOR i := 0 TO dest.aliases - 1 DO
  276. CopyAlias(source.alias[i], dest.alias[i]);
  277. END;
  278. NEW (dest.bits, source.bits.GetSize ());
  279. BitSets.CopyBits (source.bits, 0, dest.bits, 0, source.bits.GetSize ());
  280. END CopySection;
  281. PROCEDURE InitSection*(VAR dest: Section);
  282. BEGIN
  283. dest.type := 0;
  284. dest.identifier.name := "";
  285. dest.identifier.fingerprint := 0;
  286. dest.unit := 0;
  287. dest.fixed := FALSE;
  288. dest.alignment := 0;
  289. dest.fixups:= 0;
  290. dest.aliases := 0;
  291. dest.fixup := NIL;
  292. dest.alias := NIL;
  293. dest.bits := NIL;
  294. END InitSection;
  295. PROCEDURE NibbleToCharacter* (value: LONGINT): CHAR;
  296. BEGIN
  297. IF value >= 10 THEN
  298. RETURN CHR ((ORD ('A') - 10) + value);
  299. ELSE
  300. RETURN CHR (ORD ('0') + value);
  301. END;
  302. END NibbleToCharacter;
  303. PROCEDURE CharacterToNibble* (char: CHAR): LONGINT;
  304. BEGIN
  305. IF ORD (char) >= ORD ('A') THEN
  306. RETURN ORD (char) - (ORD ('A') - 10);
  307. ELSE
  308. RETURN ORD (char) - ORD ('0');
  309. END;
  310. END CharacterToNibble;
  311. PROCEDURE WriteSectionTextual (writer: Streams.Writer; CONST section: Section);
  312. CONST Separator = ' '; Tab = 09X;
  313. VAR i,offset,start, len: LONGINT; size: Bits;
  314. PROCEDURE WriteValueIdentifier (value: INTEGER; CONST identifiers: ARRAY OF ARRAY OF CHAR);
  315. BEGIN
  316. writer.String (identifiers[value]);
  317. END WriteValueIdentifier;
  318. PROCEDURE WriteFixupPattern (CONST pattern: FixupPattern);
  319. BEGIN
  320. writer.Int (pattern.offset, 0);
  321. writer.Char (Separator);
  322. writer.Int (pattern.bits, 0);
  323. END WriteFixupPattern;
  324. PROCEDURE WriteIdentifier(CONST identifier: Identifier);
  325. VAR name: SectionName;
  326. BEGIN
  327. SegmentedNameToString(identifier.name, name);
  328. writer.String (name);
  329. writer.Char (Separator);
  330. writer.Int (identifier.fingerprint, 0);
  331. END WriteIdentifier;
  332. PROCEDURE WritePattern(pattern: Pattern);
  333. VAR i: LONGINT;
  334. BEGIN
  335. WriteValueIdentifier (pattern.mode, modes);
  336. writer.Char (Separator);
  337. writer.Int (pattern.scale, 0);
  338. writer.Char (Separator);
  339. writer.Int (pattern.patterns, 0);
  340. writer.Char (Separator);
  341. FOR i := 0 TO pattern.patterns - 1 DO
  342. WriteFixupPattern (pattern.pattern[i]);
  343. writer.Char (Separator);
  344. END;
  345. END WritePattern;
  346. PROCEDURE WritePatch (CONST patch: Patch);
  347. BEGIN
  348. writer.Int (patch.displacement, 0);
  349. writer.Char (Separator);
  350. writer.Int (patch.offset, 0);
  351. END WritePatch;
  352. PROCEDURE WriteFixup (CONST fixup: Fixup);
  353. VAR i: LONGINT;
  354. BEGIN
  355. WriteIdentifier(fixup.identifier);
  356. writer.Char (Separator);
  357. WritePattern(fixup.pattern);
  358. writer.Char(Separator);
  359. writer.Int(fixup.patches,1);
  360. writer.Char(Separator);
  361. FOR i := 0 TO fixup.patches-1 DO
  362. WritePatch(fixup.patch[i]);
  363. writer.Char (Separator);
  364. END;
  365. END WriteFixup;
  366. PROCEDURE WriteAlias (CONST alias: Alias);
  367. BEGIN
  368. WriteIdentifier(alias.identifier);
  369. writer.Char (Separator);
  370. writer.Int (alias.offset, 0);
  371. END WriteAlias;
  372. PROCEDURE Zeros(offset: LONGINT): LONGINT;
  373. VAR zeros: LONGINT;
  374. BEGIN
  375. zeros := 0;
  376. WHILE (offset < size) & (section.bits.GetBits(offset, MIN(4, size-offset)) = 0) DO
  377. INC(zeros);
  378. INC(offset,4);
  379. END;
  380. RETURN zeros
  381. END Zeros;
  382. PROCEDURE GetSegment(VAR offset, start, len: LONGINT): BOOLEAN;
  383. VAR zeros: LONGINT;
  384. BEGIN
  385. INC(offset, Zeros(offset)*4);
  386. start := offset;
  387. len := 0;
  388. WHILE (offset < size) DO
  389. zeros := Zeros(offset);
  390. INC(offset, zeros*4);
  391. IF (zeros > 8) OR (offset >= size) THEN
  392. RETURN TRUE;
  393. ELSE
  394. INC(len, zeros*4);
  395. INC(len,4); INC(offset,4); (* non-zero element *)
  396. END;
  397. END;
  398. RETURN len > 0;
  399. END GetSegment;
  400. PROCEDURE WriteSegment(offset,len: LONGINT); (* offset in bits *)
  401. VAR bits: LONGINT;
  402. BEGIN
  403. ASSERT(len MOD 4 = 0); ASSERT(offset MOD 4 = 0);
  404. len := len DIV 4;
  405. writer.Int(len,1); writer.Char(Separator); writer.Int(offset DIV 4,1); writer.Char(Separator);
  406. WHILE len > 0 DO
  407. bits := section.bits.GetBits(offset, MIN(4, size-offset));
  408. writer.Char(NibbleToCharacter(bits));
  409. INC(offset, 4);
  410. DEC(len);
  411. END;
  412. writer.Ln;
  413. END WriteSegment;
  414. BEGIN
  415. IF section.type > Const THEN RETURN END; (* ignore exotic sections *)
  416. WriteValueIdentifier (section.type, categories);
  417. writer.Char (Separator);
  418. WriteIdentifier(section.identifier);
  419. writer.Char (Separator);
  420. writer.Int (section.unit, 0);
  421. writer.Char (Separator);
  422. IF section.fixed THEN WriteValueIdentifier(Fixed,relocatabilities) ELSE WriteValueIdentifier(Aligned,relocatabilities) END;
  423. writer.Char (Separator);
  424. writer.Int (section.alignment, 0);
  425. writer.Char (Separator);
  426. writer.Int (section.aliases, 0);
  427. writer.Char (Separator);
  428. writer.Int (section.fixups, 0);
  429. writer.Char (Separator);
  430. size := section.bits.GetSize ();
  431. writer.Int (size DIV section.unit, 1);
  432. ASSERT(size MOD section.unit = 0);
  433. FOR i := 0 TO section.aliases - 1 DO
  434. writer.Ln; writer.Char (Tab); WriteAlias (section.alias[i]);
  435. END;
  436. FOR i := 0 TO section.fixups - 1 DO
  437. writer.Ln; writer.Char (Tab); WriteFixup (section.fixup[i]);
  438. END;
  439. writer.Ln;
  440. offset := 0;
  441. WHILE GetSegment(offset, start, len) DO
  442. WriteSegment(start, len)
  443. END;
  444. writer.Int(0,1); writer.Ln;
  445. writer.Ln;
  446. END WriteSectionTextual;
  447. PROCEDURE ReadSectionTextual (reader: Streams.Reader; version: LONGINT; VAR section: Section);
  448. VAR i, size: LONGINT; char: CHAR; relocatibility: INTEGER; priority: LONGINT;
  449. PROCEDURE ReadValueIdentifier (VAR value: INTEGER; CONST identifiers: ARRAY OF ARRAY OF CHAR);
  450. VAR identifier: ARRAY 10 OF CHAR;
  451. BEGIN
  452. value := 0;
  453. reader.SkipWhitespace; reader.String (identifier);
  454. WHILE (value # LEN (identifiers)) & (identifier # identifiers[value]) DO INC (value); END;
  455. IF value = LEN (identifiers) THEN reader.res := Streams.FormatError; END;
  456. END ReadValueIdentifier;
  457. PROCEDURE ReadFixupPattern (VAR pattern: FixupPattern);
  458. BEGIN
  459. reader.SkipWhitespace; reader.Int (pattern.offset, FALSE);
  460. reader.SkipWhitespace; reader.Int (pattern.bits, FALSE);
  461. END ReadFixupPattern;
  462. PROCEDURE ReadIdentifier(VAR identifier: Identifier);
  463. VAR name: SectionName;
  464. BEGIN
  465. reader.SkipWhitespace;
  466. reader.String(name);
  467. StringToSegmentedName(name,identifier.name);
  468. reader.SkipWhitespace; reader.Int (identifier.fingerprint,FALSE);
  469. END ReadIdentifier;
  470. PROCEDURE ReadPattern(VAR pattern: Pattern);
  471. VAR i: LONGINT;
  472. BEGIN
  473. reader.SkipWhitespace;
  474. ReadValueIdentifier (pattern.mode, modes);
  475. reader.SkipWhitespace; reader.Int (pattern.scale, FALSE);
  476. reader.SkipWhitespace; reader.Int (pattern.patterns, FALSE);
  477. IF (pattern.pattern = NIL) OR (LEN (pattern.pattern) < pattern.patterns) THEN
  478. NEW (pattern.pattern, pattern.patterns);
  479. END;
  480. FOR i := 0 TO pattern.patterns - 1 DO
  481. ReadFixupPattern (pattern.pattern[i]);
  482. END;
  483. END ReadPattern;
  484. PROCEDURE ReadPatch (VAR patch: Patch);
  485. BEGIN
  486. reader.SkipWhitespace; reader.Int (patch.displacement, FALSE);
  487. reader.SkipWhitespace; reader.Int (patch.offset, FALSE);
  488. END ReadPatch;
  489. PROCEDURE ReadFixup (VAR fixup: Fixup);
  490. VAR i: LONGINT;
  491. BEGIN
  492. reader.SkipWhitespace; ReadIdentifier (fixup.identifier);
  493. IF fixup.pattern = NIL THEN NEW(fixup.pattern) END;
  494. reader.SkipWhitespace; ReadPattern(fixup.pattern);
  495. reader.SkipWhitespace; reader.Int (fixup.patches, FALSE);
  496. IF (fixup.patch = NIL) OR (LEN (fixup.patch) < fixup.patches) THEN
  497. NEW (fixup.patch, fixup.patches);
  498. END;
  499. FOR i := 0 TO fixup.patches - 1 DO
  500. ReadPatch (fixup.patch[i]);
  501. END;
  502. END ReadFixup;
  503. PROCEDURE ReadAlias (VAR alias: Alias);
  504. BEGIN
  505. reader.SkipWhitespace; ReadIdentifier (alias.identifier);
  506. reader.SkipWhitespace; reader.Int(alias.offset,FALSE);
  507. END ReadAlias;
  508. PROCEDURE ReadSegment(): BOOLEAN;
  509. VAR len,offset: LONGINT;
  510. BEGIN
  511. reader.Int(len,FALSE);
  512. reader.SkipWhitespace;
  513. IF len = 0 THEN RETURN FALSE END;
  514. reader.Int(offset,FALSE); offset := offset * 4;
  515. reader.SkipWhitespace;
  516. WHILE len > 0 DO
  517. reader.Char (char);
  518. section.bits.SetBits (offset, MIN (4, size - offset), CharacterToNibble (char));
  519. DEC(len); INC(offset,4);
  520. END;
  521. RETURN TRUE
  522. END ReadSegment;
  523. BEGIN
  524. ReadValueIdentifier (section.type, categories);
  525. ReadIdentifier (section.identifier);
  526. reader.SkipWhitespace; reader.Int (section.unit, FALSE);
  527. ReadValueIdentifier(relocatibility, relocatabilities);
  528. section.fixed := relocatibility = Fixed;
  529. reader.SkipWhitespace; reader.Int (section.alignment, FALSE);
  530. IF version < 5 THEN
  531. reader.SkipWhitespace; reader.Int (priority, FALSE);
  532. IF section.type = InitCode THEN
  533. IF priority = -4 THEN section.type := EntryCode;
  534. ELSIF priority = -1 THEN section.type := ExitCode;
  535. END;
  536. END;
  537. END;
  538. reader.SkipWhitespace; reader.Int (section.aliases, FALSE);
  539. reader.SkipWhitespace; reader.Int (section.fixups, FALSE);
  540. reader.SkipWhitespace; reader.Int (size, FALSE); size := size * section.unit;
  541. IF (section.aliases > 0) & ((section.alias = NIL) OR (LEN (section.alias) < section.aliases)) THEN
  542. NEW (section.alias, section.aliases);
  543. END;
  544. FOR i := 0 TO section.aliases - 1 DO
  545. ReadAlias (section.alias[i]);
  546. END;
  547. IF (section.fixups > 0) & ((section.fixup = NIL) OR (LEN (section.fixup) < section.fixups)) THEN
  548. NEW (section.fixup, section.fixups);
  549. END;
  550. FOR i := 0 TO section.fixups - 1 DO
  551. ReadFixup (section.fixup[i]);
  552. ASSERT(section.fixup[i].patch # NIL);
  553. END;
  554. IF section.bits # NIL THEN
  555. section.bits.Resize (size);
  556. section.bits.Zero();
  557. ELSE
  558. NEW (section.bits, size);
  559. END;
  560. REPEAT
  561. reader.SkipWhitespace()
  562. UNTIL ~ReadSegment()
  563. END ReadSectionTextual;
  564. PROCEDURE ReadNameList*(reader: Streams.Reader; VAR nameList: NameList; binary: BOOLEAN; poolMap: PoolMap);
  565. VAR i,len: LONGINT; name: ARRAY 256 OF CHAR;
  566. PROCEDURE ReadIdentifier(VAR name: SegmentedName);
  567. (*VAR name: SectionName;*)
  568. VAR i,num: LONGINT;
  569. BEGIN
  570. i := 0;
  571. REPEAT
  572. reader.RawNum(num);
  573. name[i] := poolMap.Get(num);
  574. INC(i);
  575. UNTIL (i = LEN(name)) OR (num < 0);
  576. WHILE i < LEN(name) DO
  577. name[i] := -1; INC(i);
  578. END;
  579. END ReadIdentifier;
  580. BEGIN
  581. IF binary THEN
  582. reader.RawNum(len);
  583. NEW(nameList, len);
  584. FOR i := 0 TO len-1 DO
  585. ReadIdentifier(nameList[i]);
  586. END;
  587. ELSE
  588. reader.SkipWhitespace;
  589. reader.Int(len,FALSE);
  590. NEW(nameList, len);
  591. FOR i := 0 TO len-1 DO
  592. reader.SkipWhitespace;
  593. reader.String(name);
  594. nameList[i] := name;
  595. END;
  596. END;
  597. END ReadNameList;
  598. PROCEDURE WriteNameList*(writer: Streams.Writer; nameList: NameList; binary: BOOLEAN; poolMap: PoolMap);
  599. VAR i,len: LONGINT; name: ARRAY 256 OF CHAR;
  600. CONST Separator = ' ';
  601. PROCEDURE WriteIdentifier(CONST name: SegmentedName);
  602. VAR i,num: LONGINT;
  603. BEGIN
  604. i := 0;
  605. REPEAT
  606. num := poolMap.Get(name[i]);
  607. writer.RawNum(num);
  608. INC(i);
  609. UNTIL (i = LEN(name)) OR (num < 0);
  610. END WriteIdentifier;
  611. BEGIN
  612. IF nameList = NIL THEN len := 0
  613. ELSE len := LEN(nameList);
  614. END;
  615. IF binary THEN
  616. writer.RawNum(len);
  617. FOR i := 0 TO len-1 DO
  618. WriteIdentifier(nameList[i]);
  619. END;
  620. ELSE
  621. writer.Int(len,0);
  622. FOR i := 0 TO len-1 DO
  623. name := nameList[i];
  624. writer.Char(Separator);
  625. writer.String(name);
  626. END;
  627. writer.Ln;
  628. END;
  629. END WriteNameList;
  630. PROCEDURE WriteSectionBinary (writer: Streams.Writer; CONST section: Section; poolMap: PoolMap);
  631. VAR pos, i, offset, start, len: LONGINT; size: Bits;
  632. CONST ByteSize=8;
  633. PROCEDURE WriteValueIdentifier (value: INTEGER; CONST identifiers: ARRAY OF ARRAY OF CHAR);
  634. BEGIN
  635. writer.RawNum(value);
  636. (*
  637. writer.RawString (identifiers[value]);
  638. *)
  639. END WriteValueIdentifier;
  640. PROCEDURE WriteFixupPattern (CONST pattern: FixupPattern);
  641. BEGIN
  642. writer.RawNum (pattern.offset);
  643. writer.RawNum (pattern.bits);
  644. INC(statFixupPatterns);
  645. END WriteFixupPattern;
  646. PROCEDURE WriteIdentifier(CONST identifier: Identifier);
  647. VAR i,num: LONGINT;
  648. BEGIN
  649. i := 0;
  650. REPEAT
  651. num := poolMap.Get(identifier.name[i]);
  652. writer.RawNum(num);
  653. INC(i);
  654. UNTIL (i = LEN(identifier.name)) OR (num < 0);
  655. writer.RawNum (identifier.fingerprint);
  656. END WriteIdentifier;
  657. PROCEDURE WritePattern(pattern: Pattern);
  658. VAR i: LONGINT;
  659. BEGIN
  660. WriteValueIdentifier (pattern.mode, modes);
  661. writer.RawNum (pattern.scale);
  662. writer.RawNum (pattern.patterns);
  663. FOR i := 0 TO pattern.patterns - 1 DO
  664. WriteFixupPattern (pattern.pattern[i]);
  665. END;
  666. END WritePattern;
  667. PROCEDURE WritePatch (CONST patch: Patch);
  668. BEGIN
  669. writer.RawNum (patch.displacement);
  670. writer.RawNum (patch.offset);
  671. INC(statFixupPatches);
  672. END WritePatch;
  673. PROCEDURE WriteFixup (CONST fixup: Fixup);
  674. VAR i: LONGINT;
  675. BEGIN
  676. INC(statFixups);
  677. WriteIdentifier(fixup.identifier);
  678. WritePattern(fixup.pattern);
  679. writer.RawNum(fixup.patches);
  680. ASSERT(fixup.patches > 0);
  681. FOR i := 0 TO fixup.patches-1 DO
  682. WritePatch(fixup.patch[i]);
  683. END;
  684. END WriteFixup;
  685. PROCEDURE WriteAlias (CONST alias: Alias);
  686. BEGIN
  687. WriteIdentifier(alias.identifier);
  688. writer.RawNum(alias.offset);
  689. END WriteAlias;
  690. PROCEDURE Zeros(offset: LONGINT): LONGINT;
  691. VAR zeros: LONGINT;
  692. BEGIN
  693. WHILE (offset < size) & (section.bits.GetBits(offset, MIN(ByteSize, size-offset)) = 0) DO
  694. INC(zeros);
  695. INC(offset,ByteSize);
  696. END;
  697. RETURN zeros
  698. END Zeros;
  699. PROCEDURE GetSegment(VAR offset, start, len: LONGINT): BOOLEAN;
  700. VAR zeros: LONGINT;
  701. BEGIN
  702. INC(offset, Zeros(offset)*ByteSize);
  703. start := offset;
  704. len := 0;
  705. WHILE (offset < size) DO
  706. zeros := Zeros(offset);
  707. INC(offset, zeros*ByteSize);
  708. IF (zeros > 2) (* best value evaluated with statisitc over whole release *) OR (offset >= size) THEN
  709. RETURN TRUE;
  710. ELSE
  711. ASSERT(offset < size);
  712. INC(len, zeros*ByteSize);
  713. INC(len,ByteSize); INC(offset,ByteSize); (* non-zero element *)
  714. END;
  715. END;
  716. RETURN len > 0;
  717. END GetSegment;
  718. PROCEDURE WriteSegment(offset,len: LONGINT); (* offset in bits *)
  719. VAR bits: LONGINT; pos: LONGINT;
  720. BEGIN
  721. pos := writer.Pos();
  722. ASSERT(len > 0);
  723. ASSERT(len MOD ByteSize = 0); ASSERT(offset MOD ByteSize = 0);
  724. len := len DIV ByteSize;
  725. writer.RawNum(len); writer.RawNum(offset DIV ByteSize);
  726. WHILE len > 0 DO
  727. bits := section.bits.GetBits(offset, MIN(ByteSize, size-offset));
  728. INC(offset, ByteSize);
  729. DEC(len);
  730. writer.Char(CHR(bits));
  731. END;
  732. INC(statSegments); INC(statSegmentsSize, writer.Pos()-pos);
  733. END WriteSegment;
  734. BEGIN
  735. (* header *)
  736. pos := writer.Pos();
  737. IF section.type > Const THEN RETURN END; (* ignore exotic sections *)
  738. writer.Char(1X);
  739. WriteValueIdentifier (section.type, categories);
  740. WriteIdentifier(section.identifier);
  741. writer.RawNum (section.unit);
  742. IF section.fixed THEN WriteValueIdentifier(Fixed,relocatabilities) ELSE WriteValueIdentifier(Aligned,relocatabilities) END;
  743. writer.RawNum (section.alignment);
  744. writer.RawNum (section.aliases);
  745. writer.RawNum (section.fixups);
  746. size := section.bits.GetSize ();
  747. writer.RawNum (size DIV section.unit);
  748. INC(statHeaders);
  749. INC(statHeadersSize, writer.Pos()-pos);
  750. (* aliases *)
  751. pos := writer.Pos();
  752. ASSERT(size MOD section.unit = 0);
  753. FOR i := 0 TO section.aliases - 1 DO
  754. WriteAlias (section.alias[i]);
  755. END;
  756. INC(statAliases, section.aliases);
  757. INC(statAliasesSize, writer.Pos()-pos);
  758. (* fixups *)
  759. pos := writer.Pos();
  760. FOR i := 0 TO section.fixups - 1 DO
  761. WriteFixup (section.fixup[i]);
  762. END;
  763. INC(statFixups, section.fixups);
  764. INC(statFixupsSize, writer.Pos()-pos);
  765. (* code / data *)
  766. pos := writer.Pos();
  767. offset := 0;
  768. WHILE GetSegment(offset, start, len) DO
  769. WriteSegment(start, len);
  770. END;
  771. writer.RawNum(0);
  772. CASE section.type OF
  773. InitCode: INC(statInitSections); INC(statInitSectionsSize, writer.Pos()-pos);
  774. |BodyCode: INC(statBodySections); INC(statBodySectionsSize, writer.Pos()-pos);
  775. |Code: INC(statCodeSections); INC(statCodeSectionsSize, writer.Pos()-pos);
  776. |Data: INC(statDataSections); INC(statDataSectionsSize, writer.Pos()-pos);
  777. |Const: INC(statConstSections); INC(statConstSectionsSize, writer.Pos()-pos);
  778. ELSE (* ignored *)
  779. END;
  780. END WriteSectionBinary;
  781. PROCEDURE ReadSectionBinary (reader: Streams.Reader; version: LONGINT; VAR section: Section; poolMap: PoolMap);
  782. VAR i, size: LONGINT; relocatibility: INTEGER; ch: CHAR; priority: LONGINT;
  783. CONST ByteSize=8;
  784. PROCEDURE ReadValueIdentifier (VAR value: INTEGER; CONST identifiers: ARRAY OF ARRAY OF CHAR);
  785. (* VAR identifier: ARRAY 10 OF CHAR; *)
  786. VAR num: LONGINT;
  787. BEGIN
  788. reader.RawNum(num);
  789. value := SHORT(num);
  790. (*
  791. value := 0;
  792. reader.RawString (identifier);
  793. WHILE (value # LEN (identifiers)) & (identifier # identifiers[value]) DO INC (value); END;
  794. IF value = LEN (identifiers) THEN reader.res := Streams.FormatError; END;
  795. *)
  796. END ReadValueIdentifier;
  797. PROCEDURE ReadIdentifier(VAR identifier: Identifier);
  798. (*VAR name: SectionName;*)
  799. VAR i,num: LONGINT;
  800. BEGIN
  801. i := 0;
  802. REPEAT
  803. reader.RawNum(num);
  804. identifier.name[i] := poolMap.Get(num);
  805. INC(i);
  806. UNTIL (i = LEN(identifier.name)) OR (num < 0);
  807. WHILE i < LEN(identifier.name) DO
  808. identifier.name[i] := -1; INC(i);
  809. END;
  810. reader.RawNum (identifier.fingerprint);
  811. END ReadIdentifier;
  812. PROCEDURE ReadFixupPattern (VAR pattern: FixupPattern);
  813. BEGIN
  814. reader.RawNum (pattern.offset);
  815. reader.RawNum (pattern.bits);
  816. END ReadFixupPattern;
  817. PROCEDURE ReadPattern(VAR pattern: Pattern);
  818. VAR i: LONGINT;
  819. BEGIN
  820. ReadValueIdentifier (pattern.mode, modes);
  821. reader.RawNum (pattern.scale);
  822. reader.RawNum (pattern.patterns);
  823. IF (pattern.pattern = NIL) OR (LEN (pattern.pattern) < pattern.patterns) THEN
  824. NEW (pattern.pattern, pattern.patterns);
  825. END;
  826. FOR i := 0 TO pattern.patterns - 1 DO
  827. ReadFixupPattern (pattern.pattern[i]);
  828. END;
  829. END ReadPattern;
  830. PROCEDURE ReadPatch(VAR patch: Patch);
  831. BEGIN
  832. reader.RawNum(patch.displacement);
  833. reader.RawNum(patch.offset);
  834. END ReadPatch;
  835. PROCEDURE ReadFixup (VAR fixup: Fixup);
  836. VAR i: LONGINT;
  837. BEGIN
  838. ReadIdentifier (fixup.identifier);
  839. IF fixup.pattern = NIL THEN NEW(fixup.pattern) END;
  840. ReadPattern(fixup.pattern);
  841. reader.RawNum (fixup.patches);
  842. IF fixup.patches > 0 THEN
  843. IF (fixup.patch = NIL) OR (LEN (fixup.patch) < fixup.patches) THEN
  844. NEW (fixup.patch, fixup.patches);
  845. END;
  846. FOR i := 0 TO fixup.patches - 1 DO
  847. ReadPatch (fixup.patch[i]);
  848. END;
  849. END;
  850. END ReadFixup;
  851. PROCEDURE ReadAlias (VAR alias: Alias);
  852. BEGIN
  853. ReadIdentifier (alias.identifier);
  854. reader.RawNum (alias.offset);
  855. END ReadAlias;
  856. PROCEDURE ReadSegment(): BOOLEAN;
  857. VAR len,offset: LONGINT; c: CHAR;
  858. segment: ARRAY 128 OF CHAR;
  859. received: LONGINT;
  860. BEGIN
  861. reader.RawNum(len);
  862. IF len = 0 THEN RETURN FALSE END;
  863. reader.RawNum(offset); offset := offset * ByteSize;
  864. WHILE len > LEN(segment) DO
  865. reader.Bytes(segment, 0, LEN(segment), received);
  866. ASSERT(received = LEN(segment));
  867. section.bits.SetBytes(offset, LEN(segment), segment);
  868. DEC(len, received);
  869. INC(offset, received*ByteSize);
  870. END;
  871. IF size MOD 8 # 0 THEN
  872. reader.Bytes(segment, 0, len-1, received);
  873. ASSERT(received = len-1);
  874. section.bits.SetBytes(offset, received, segment);
  875. DEC(len, received);
  876. INC(offset, received*ByteSize);
  877. (* last byte: only part of a byte *)
  878. reader.Char(c);
  879. section.bits.SetBits (offset, MIN (ByteSize, size - offset), ORD(c));
  880. ELSE
  881. reader.Bytes(segment, 0, len, received);
  882. ASSERT(received = len);
  883. section.bits.SetBytes(offset, received, segment);
  884. END;
  885. RETURN TRUE
  886. END ReadSegment;
  887. BEGIN
  888. reader.Char(ch); ASSERT(ch = 1X);
  889. ReadValueIdentifier (section.type, categories);
  890. ReadIdentifier (section.identifier);
  891. reader.RawNum (section.unit);
  892. ReadValueIdentifier(relocatibility, relocatabilities);
  893. section.fixed := relocatibility = Fixed;
  894. reader.RawNum (section.alignment);
  895. IF version < 5 THEN
  896. reader.RawNum (priority);
  897. CASE section.type OF
  898. 0: section.type := InitCode;
  899. |1:section.type := BodyCode;
  900. |2:section.type := Code;
  901. |3:section.type := Data;
  902. |4:section.type := Const;
  903. END;
  904. IF section.type = InitCode THEN
  905. IF priority = -4 THEN section.type := EntryCode;
  906. ELSIF priority = -1 THEN section.type := ExitCode;
  907. END;
  908. END;
  909. END;
  910. reader.RawNum (section.aliases);
  911. reader.RawNum (section.fixups);
  912. reader.RawNum (size); size := size * section.unit;
  913. IF (section.aliases > 0) &((section.alias = NIL) OR (LEN (section.alias) < section.aliases)) THEN
  914. NEW (section.alias, section.aliases);
  915. END;
  916. FOR i := 0 TO section.aliases - 1 DO
  917. ReadAlias (section.alias[i]);
  918. END;
  919. IF (section.fixups > 0) & ((section.fixup = NIL) OR (LEN (section.fixup) < section.fixups)) THEN
  920. NEW (section.fixup, section.fixups);
  921. END;
  922. FOR i := 0 TO section.fixups - 1 DO
  923. ReadFixup (section.fixup[i]);
  924. END;
  925. IF section.bits # NIL THEN
  926. section.bits.Resize (size);
  927. section.bits.Zero();
  928. ELSE
  929. NEW (section.bits, size);
  930. END;
  931. WHILE ReadSegment() DO
  932. END;
  933. END ReadSectionBinary;
  934. PROCEDURE ReadSection*(reader: Streams.Reader; version: LONGINT; VAR section: Section; binary: BOOLEAN; poolMap: PoolMap);
  935. BEGIN
  936. IF binary THEN
  937. ReadSectionBinary(reader,version, section,poolMap)
  938. ELSE
  939. ReadSectionTextual(reader,version,section);
  940. END
  941. END ReadSection;
  942. PROCEDURE WriteSection*(writer: Streams.Writer; CONST section: Section; binary: BOOLEAN; poolMap: PoolMap);
  943. VAR pos: LONGINT;
  944. BEGIN
  945. pos := writer.Pos();
  946. IF binary THEN
  947. WriteSectionBinary(writer,section, poolMap)
  948. ELSE
  949. WriteSectionTextual(writer,section)
  950. END;
  951. INC(statSections); INC(statSectionsTotalSize, writer.Pos()-pos);
  952. END WriteSection;
  953. PROCEDURE SetFixups*(VAR section: Section; fixups: LONGINT; fixup: Fixups);
  954. BEGIN
  955. section.fixups := fixups;
  956. section.fixup := fixup;
  957. END SetFixups;
  958. PROCEDURE SetAliases*(VAR section: Section; aliases: LONGINT; alias: Aliases);
  959. BEGIN
  960. section.aliases := aliases;
  961. section.alias := alias;
  962. END SetAliases;
  963. PROCEDURE AddPatch*(VAR patches: LONGINT; VAR patch: Patches; disp, ofs: LONGINT);
  964. VAR newPatch: Patches; newPatches:LONGINT; i: LONGINT;
  965. BEGIN
  966. FOR i := 0 TO patches-1 DO
  967. ASSERT(patch[i].offset # ofs);
  968. END;
  969. newPatches := patches+1;
  970. IF (patch = NIL) OR (LEN(patch) < newPatches) THEN
  971. NEW(newPatch, 2*newPatches);
  972. FOR i := 0 TO patches-1 DO
  973. newPatch[i].offset := patch[i].offset;
  974. newPatch[i].displacement := patch[i].displacement;
  975. END;
  976. patch := newPatch;
  977. END;
  978. patch[patches].offset := ofs;
  979. patch[patches].displacement := disp;
  980. patches := newPatches;
  981. END AddPatch;
  982. PROCEDURE SameFixupPattern(patterns: LONGINT; left, right: FixupPatterns): BOOLEAN;
  983. VAR i: LONGINT;
  984. BEGIN
  985. FOR i := 0 TO patterns-1 DO
  986. IF (left[i].offset # right[i].offset) OR (left[i].bits # right[i].bits) THEN RETURN FALSE END;
  987. END;
  988. RETURN TRUE
  989. END SameFixupPattern;
  990. PROCEDURE HasPattern(pat: Pattern; mode, scale: LONGINT; patterns: LONGINT; pattern: FixupPatterns): BOOLEAN;
  991. BEGIN
  992. RETURN (pat.mode = mode) & (pat.scale = scale) & (pat.patterns = patterns) & SameFixupPattern(patterns, pat.pattern, pattern);
  993. END HasPattern;
  994. (*
  995. PROCEDURE AddPatch(VAR patches: LONGINT; VAR patch: Patches; mode: INTEGER; displacement, scale: LONGINT; patterns: LONGINT; pattern: FixupPatterns; offset: LONGINT);
  996. VAR i: LONGINT; newPatches: LONGINT; newPatch: Patches; len: LONGINT;
  997. BEGIN
  998. FOR i := 0 TO patches-1 DO
  999. len := LEN(patch);
  1000. ASSERT(patch # NIL,101);
  1001. ASSERT(LEN(patch) > i,102);
  1002. IF (patch[i].mode = mode) & (patch[i].displacement = displacement) & (patch[i].scale = scale) & (patch[i].patterns = patterns) & SamePattern(patterns, patch[i].pattern, pattern) THEN
  1003. AddOffset(patch[i].offsets, patch[i].offset, offset);
  1004. RETURN
  1005. END;
  1006. END;
  1007. newPatches := patches+1;
  1008. IF (patch = NIL) OR (LEN(patch) < newPatches) THEN
  1009. ASSERT(newPatches > 0);
  1010. NEW(newPatch, 2*newPatches);
  1011. FOR i := 0 TO patches-1 DO
  1012. newPatch[i] := patch[i];
  1013. (*
  1014. CopyPatch(patch[i], newPatch[i]);
  1015. *)
  1016. END;
  1017. patch := newPatch;
  1018. END;
  1019. ASSERT(LEN(patch) > patches);
  1020. patch[patches].mode := mode;
  1021. patch[patches].displacement := displacement;
  1022. patch[patches].patterns := patterns;
  1023. patch[patches].pattern := pattern;
  1024. patch[patches].offsets := 0;
  1025. patch[patches].offset := NIL;
  1026. AddOffset(patch[patches].offsets, patch[patches].offset, offset);
  1027. patches := newPatches;
  1028. (* increase size and add *)
  1029. END AddPatch;
  1030. *)
  1031. PROCEDURE AddFixup*(VAR fixups: LONGINT; VAR fixup: Fixups; CONST name: SegmentedName; fingerprint: LONGINT; mode: INTEGER; scale: LONGINT; patterns: LONGINT; pattern: FixupPatterns): LONGINT;
  1032. VAR i: LONGINT; newFixups, index: LONGINT; newFixup: Fixups;
  1033. BEGIN
  1034. FOR i := 0 TO fixups-1 DO
  1035. IF (fixup[i].identifier.fingerprint = fingerprint) & (name =fixup[i].identifier.name) & HasPattern(fixup[i].pattern, mode, scale, patterns, pattern) THEN
  1036. RETURN i
  1037. END;
  1038. END;
  1039. newFixups := fixups+1;
  1040. IF (fixup = NIL) OR (LEN(fixup) < newFixups) THEN
  1041. NEW(newFixup, MAX(2*newFixups,32));
  1042. FOR i := 0 TO fixups-1 DO
  1043. newFixup[i] := fixup[i];
  1044. (*CopyFixup(fixup[i], newFixup[i]);*)
  1045. END;
  1046. fixup := newFixup;
  1047. END;
  1048. fixup[fixups].identifier.name := name;
  1049. fixup[fixups].identifier.fingerprint := fingerprint;
  1050. NEW(fixup[fixups].pattern);
  1051. fixup[fixups].pattern.scale := scale;
  1052. fixup[fixups].pattern.mode := mode;
  1053. fixup[fixups].pattern.patterns := patterns;
  1054. fixup[fixups].pattern.pattern := pattern;
  1055. index := fixups;
  1056. fixups := newFixups;
  1057. (* increase size and add *)
  1058. RETURN index;
  1059. END AddFixup;
  1060. PROCEDURE AddAlias*(VAR aliases: LONGINT; VAR alias: Aliases; CONST name: SegmentedName; fingerprint, offset: LONGINT): LONGINT;
  1061. VAR i: LONGINT; newAliases, index: LONGINT; newAlias: Aliases;
  1062. BEGIN
  1063. newAliases := aliases+1;
  1064. IF (alias = NIL) OR (LEN(alias) < newAliases) THEN
  1065. NEW(newAlias, MAX(2*newAliases,32));
  1066. FOR i := 0 TO aliases-1 DO
  1067. newAlias[i] := alias[i];
  1068. (*CopyAlias(alias[i], newAlias[i]);*)
  1069. END;
  1070. alias := newAlias;
  1071. END;
  1072. alias[aliases].identifier.name := name;
  1073. alias[aliases].identifier.fingerprint := fingerprint;
  1074. alias[aliases].offset := offset;
  1075. index := aliases;
  1076. aliases := newAliases;
  1077. (* increase size and add *)
  1078. RETURN index;
  1079. END AddAlias;
  1080. PROCEDURE StringToSegmentedName*(CONST name: ARRAY OF CHAR; VAR segmentedName: SegmentedName);
  1081. VAR i,j,segment: LONGINT; n: SectionName;
  1082. BEGIN
  1083. (* convert a string of the form A.B.C.suffix to [S(A), S(B), S(C), S(suffix)] *)
  1084. segment := 0; i := 0;
  1085. WHILE (segment < LEN(segmentedName)) DO
  1086. j := 0;
  1087. WHILE (name[i] # 0X) & (name[i] # ".") DO
  1088. n[j] := name[i]; INC(i); INC(j);
  1089. END;
  1090. IF j > 0 THEN
  1091. IF segment = LEN(segmentedName)-1 THEN
  1092. WHILE (name[i] # 0X) DO n[j] := name[i]; INC(i); INC(j); END;
  1093. END;
  1094. n[j] := 0X; StringPool.GetIndex(n,segmentedName[segment]);
  1095. ELSE
  1096. segmentedName[segment] := -1
  1097. END;
  1098. IF name[i] = "." THEN INC(i) END;
  1099. INC(segment);
  1100. END;
  1101. END StringToSegmentedName;
  1102. PROCEDURE SegmentedNameToString*(CONST segmentedName: SegmentedName; VAR name: ARRAY OF CHAR);
  1103. VAR i,j, segment: LONGINT; n: SectionName;
  1104. BEGIN
  1105. i := 0; segment := 0;
  1106. WHILE (segment < LEN(segmentedName)) & (segmentedName[segment] >= 0) DO
  1107. IF segment > 0 THEN name[i] := "."; INC(i) END;
  1108. StringPool.GetString(segmentedName[segment],n);
  1109. j := 0;
  1110. WHILE n[j] # 0X DO
  1111. name[i] := n[j]; INC(i); INC(j);
  1112. END;
  1113. INC(segment);
  1114. END;
  1115. name[i] := 0X;
  1116. END SegmentedNameToString;
  1117. (* result = 0 : equal strings, result < 0: s1 before s2, result > 0 : s1 after s2 (alphanumerically) *)
  1118. PROCEDURE CompareSegmentedNames*(CONST s1, s2: SegmentedName): LONGINT;
  1119. VAR n1, n2: SectionName; index: LONGINT; ch1, ch2: CHAR;
  1120. BEGIN
  1121. SegmentedNameToString(s1,n1);
  1122. SegmentedNameToString(s2,n2);
  1123. index := 0;
  1124. ch1 := n1[index];
  1125. ch2 := n2[index];
  1126. WHILE (ch1 # 0X) & (ch1 = ch2) DO
  1127. INC(index);
  1128. ch1 := n1[index];
  1129. ch2 := n2[index];
  1130. END;
  1131. RETURN ORD(ch1) - ORD(ch2);
  1132. END CompareSegmentedNames;
  1133. OPERATOR "="*(CONST l,r: SegmentedName): BOOLEAN;
  1134. VAR i: LONGINT;
  1135. BEGIN
  1136. i := 0; WHILE (i < LEN(l)) & (l[i] = r[i]) & (l[i] # -1) DO INC(i) END; RETURN (i = LEN(l)) OR (l[i] = r[i]);
  1137. END "=";
  1138. OPERATOR "="*(CONST l,r: Identifier): BOOLEAN;
  1139. BEGIN
  1140. RETURN (l.name = r.name) & (r.fingerprint = l.fingerprint)
  1141. END "=";
  1142. OPERATOR "#"*(CONST l,r: Identifier): BOOLEAN;
  1143. BEGIN
  1144. RETURN (l.name # r.name) OR (r.fingerprint # l.fingerprint)
  1145. END "#";
  1146. OPERATOR ":="*(VAR l: SegmentedName; CONST r: ARRAY OF CHAR);
  1147. BEGIN
  1148. StringToSegmentedName(r, l)
  1149. END ":=";
  1150. OPERATOR ":="*(VAR l: ARRAY OF CHAR; CONST r: SegmentedName);
  1151. BEGIN
  1152. SegmentedNameToString(r, l)
  1153. END ":=";
  1154. OPERATOR "="*(CONST l: SegmentedName; CONST r: ARRAY OF CHAR): BOOLEAN;
  1155. VAR i,j,segment: LONGINT; n: SectionName;
  1156. BEGIN
  1157. i := 0; segment := 0;
  1158. WHILE (segment < LEN(l)) DO
  1159. IF l[segment] < 0 THEN
  1160. RETURN r[i] = 0X
  1161. ELSE
  1162. IF (segment>0) THEN
  1163. IF (r[i] # ".") THEN RETURN FALSE END;
  1164. INC(i);
  1165. END;
  1166. StringPool.GetString(l[segment], n);
  1167. j := 0;
  1168. WHILE (r[i] = n[j]) & (n[j] # 0X) & (r[i] # 0X) DO
  1169. INC(i); INC(j);
  1170. END;
  1171. IF n[j] # 0X THEN RETURN FALSE END;
  1172. END;
  1173. INC(segment);
  1174. END;
  1175. RETURN r[i] = 0X;
  1176. END "=";
  1177. OPERATOR "="*(CONST l: ARRAY OF CHAR; r: SegmentedName): BOOLEAN;
  1178. BEGIN
  1179. RETURN r = l
  1180. END "=";
  1181. OPERATOR "#"*(CONST l: SegmentedName; CONST r: ARRAY OF CHAR): BOOLEAN;
  1182. BEGIN RETURN ~(l=r)
  1183. END "#";
  1184. OPERATOR "#"*(CONST l: ARRAY OF CHAR; r: SegmentedName): BOOLEAN;
  1185. BEGIN
  1186. RETURN ~(r=l)
  1187. END "#";
  1188. OPERATOR "#"*(CONST l,r: SegmentedName): BOOLEAN;
  1189. VAR i: LONGINT;
  1190. BEGIN
  1191. i := 0; WHILE (i<LEN(l)) & (l[i] = r[i]) & (l[i] # -1) DO INC(i) END; RETURN (i<LEN(l)) & (l[i] # r[i]);
  1192. END "#";
  1193. PROCEDURE Statistics*;
  1194. VAR sections: LONGINT; sectionsContentSize: LONGINT;
  1195. BEGIN
  1196. TRACE(statHeaders, statHeadersSize);
  1197. TRACE(statFixups, statFixupsSize, statFixupPatterns, statFixupPatches);
  1198. TRACE(statAliases, statAliasesSize);
  1199. TRACE(statSegments, statSegmentsSize, statSegmentsSize DIV MAX(1,statSegments));
  1200. TRACE(statCodeSections, statCodeSectionsSize);
  1201. TRACE(statDataSections, statDataSectionsSize);
  1202. TRACE(statConstSections, statConstSectionsSize);
  1203. TRACE(statInitSections, statInitSectionsSize);
  1204. TRACE(statBodySections, statBodySectionsSize);
  1205. sections := statCodeSections + statDataSections + statConstSections + statInitSections + statBodySections;
  1206. sectionsContentSize := statCodeSectionsSize + statDataSectionsSize + statConstSectionsSize + statInitSectionsSize + statBodySectionsSize;
  1207. TRACE(sections, sectionsContentSize);
  1208. TRACE(statSections, statSectionsTotalSize);
  1209. END Statistics;
  1210. PROCEDURE ResetStatistics*;
  1211. BEGIN
  1212. statHeaders := 0; statHeadersSize := 0;
  1213. statFixups := 0; statFixupsSize := 0; statFixupPatterns := 0; statFixupPatches := 0;
  1214. statAliases := 0; statAliasesSize := 0;
  1215. statSegments := 0; statSegmentsSize := 0;
  1216. statCodeSections := 0; statCodeSectionsSize := 0;
  1217. statDataSections := 0; statDataSectionsSize := 0;
  1218. statConstSections := 0; statConstSectionsSize := 0;
  1219. statInitSections := 0; statInitSectionsSize := 0;
  1220. statBodySections := 0; statBodySectionsSize := 0;
  1221. statSections := 0; statSectionsTotalSize := 0;
  1222. END ResetStatistics;
  1223. BEGIN
  1224. categories[Code] := "code";
  1225. categories[EntryCode] := "entrycode";
  1226. categories[InitCode] := "initcode";
  1227. categories[ExitCode] := "exitcode";
  1228. categories[BodyCode] := "bodycode";
  1229. categories[Data] := "data";
  1230. categories[Const] := "const";
  1231. modes[Absolute] := "abs";
  1232. modes[Relative] := "rel";
  1233. relocatabilities[Fixed] := "fixed";
  1234. relocatabilities[Aligned] := "aligned";
  1235. ResetStatistics;
  1236. END ObjectFile.
  1237. ObjectFile.Test