2
0

ObjectFile.Mod 39 KB

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