ObjectFile.Mod 39 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378
  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.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,num: 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; bits: LONGINT; name: ARRAY 256 OF CHAR;
  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. VAR i: LONGINT;
  687. BEGIN
  688. WriteIdentifier(alias.identifier);
  689. writer.RawNum(alias.offset);
  690. END WriteAlias;
  691. PROCEDURE Zeros(offset: LONGINT): LONGINT;
  692. VAR zeros: LONGINT;
  693. BEGIN
  694. WHILE (offset < size) & (section.bits.GetBits(offset, MIN(ByteSize, size-offset)) = 0) DO
  695. INC(zeros);
  696. INC(offset,ByteSize);
  697. END;
  698. RETURN zeros
  699. END Zeros;
  700. PROCEDURE GetSegment(VAR offset, start, len: LONGINT): BOOLEAN;
  701. VAR zeros: LONGINT;
  702. BEGIN
  703. INC(offset, Zeros(offset)*ByteSize);
  704. start := offset;
  705. len := 0;
  706. WHILE (offset < size) DO
  707. zeros := Zeros(offset);
  708. INC(offset, zeros*ByteSize);
  709. IF (zeros > 2) (* best value evaluated with statisitc over whole release *) OR (offset >= size) THEN
  710. RETURN TRUE;
  711. ELSE
  712. ASSERT(offset < size);
  713. INC(len, zeros*ByteSize);
  714. INC(len,ByteSize); INC(offset,ByteSize); (* non-zero element *)
  715. END;
  716. END;
  717. RETURN len > 0;
  718. END GetSegment;
  719. PROCEDURE WriteSegment(offset,len: LONGINT); (* offset in bits *)
  720. VAR bits: LONGINT; first: BOOLEAN; pos: LONGINT;
  721. BEGIN
  722. pos := writer.Pos();
  723. ASSERT(len > 0);
  724. ASSERT(len MOD ByteSize = 0); ASSERT(offset MOD ByteSize = 0);
  725. len := len DIV ByteSize;
  726. writer.RawNum(len); writer.RawNum(offset DIV ByteSize);
  727. WHILE len > 0 DO
  728. bits := section.bits.GetBits(offset, MIN(ByteSize, size-offset));
  729. INC(offset, ByteSize);
  730. DEC(len);
  731. writer.Char(CHR(bits));
  732. END;
  733. INC(statSegments); INC(statSegmentsSize, writer.Pos()-pos);
  734. END WriteSegment;
  735. BEGIN
  736. (* header *)
  737. pos := writer.Pos();
  738. IF section.type > Const THEN RETURN END; (* ignore exotic sections *)
  739. writer.Char(1X);
  740. WriteValueIdentifier (section.type, categories);
  741. WriteIdentifier(section.identifier);
  742. writer.RawNum (section.unit);
  743. IF section.fixed THEN WriteValueIdentifier(Fixed,relocatabilities) ELSE WriteValueIdentifier(Aligned,relocatabilities) END;
  744. writer.RawNum (section.alignment);
  745. writer.RawNum (section.priority);
  746. writer.RawNum (section.aliases);
  747. writer.RawNum (section.fixups);
  748. size := section.bits.GetSize ();
  749. writer.RawNum (size DIV section.unit);
  750. INC(statHeaders);
  751. INC(statHeadersSize, writer.Pos()-pos);
  752. (* aliases *)
  753. pos := writer.Pos();
  754. ASSERT(size MOD section.unit = 0);
  755. FOR i := 0 TO section.aliases - 1 DO
  756. WriteAlias (section.alias[i]);
  757. END;
  758. INC(statAliases, section.aliases);
  759. INC(statAliasesSize, writer.Pos()-pos);
  760. (* fixups *)
  761. pos := writer.Pos();
  762. FOR i := 0 TO section.fixups - 1 DO
  763. WriteFixup (section.fixup[i]);
  764. END;
  765. INC(statFixups, section.fixups);
  766. INC(statFixupsSize, writer.Pos()-pos);
  767. (* code / data *)
  768. pos := writer.Pos();
  769. offset := 0;
  770. WHILE GetSegment(offset, start, len) DO
  771. WriteSegment(start, len);
  772. END;
  773. writer.RawNum(0);
  774. CASE section.type OF
  775. InitCode: INC(statInitSections); INC(statInitSectionsSize, writer.Pos()-pos);
  776. |BodyCode: INC(statBodySections); INC(statBodySectionsSize, writer.Pos()-pos);
  777. |Code: INC(statCodeSections); INC(statCodeSectionsSize, writer.Pos()-pos);
  778. |Data: INC(statDataSections); INC(statDataSectionsSize, writer.Pos()-pos);
  779. |Const: INC(statConstSections); INC(statConstSectionsSize, writer.Pos()-pos);
  780. ELSE (* ignored *)
  781. END;
  782. END WriteSectionBinary;
  783. PROCEDURE ReadSectionBinary (reader: Streams.Reader; VAR section: Section; poolMap: PoolMap);
  784. VAR i, size: LONGINT; char: CHAR; relocatibility: INTEGER; num: LONGINT; ch: CHAR;
  785. CONST ByteSize=8;
  786. PROCEDURE ReadValueIdentifier (VAR value: INTEGER; CONST identifiers: ARRAY OF ARRAY OF CHAR);
  787. (* VAR identifier: ARRAY 10 OF CHAR; *)
  788. VAR num: LONGINT;
  789. BEGIN
  790. reader.RawNum(num);
  791. value := SHORT(num);
  792. (*
  793. value := 0;
  794. reader.RawString (identifier);
  795. WHILE (value # LEN (identifiers)) & (identifier # identifiers[value]) DO INC (value); END;
  796. IF value = LEN (identifiers) THEN reader.res := Streams.FormatError; END;
  797. *)
  798. END ReadValueIdentifier;
  799. PROCEDURE ReadIdentifier(VAR identifier: Identifier);
  800. (*VAR name: SectionName;*)
  801. VAR i,num: LONGINT;
  802. BEGIN
  803. i := 0;
  804. REPEAT
  805. reader.RawNum(num);
  806. identifier.name[i] := poolMap.Get(num);
  807. INC(i);
  808. UNTIL (i = LEN(identifier.name)) OR (num < 0);
  809. WHILE i < LEN(identifier.name) DO
  810. identifier.name[i] := -1; INC(i);
  811. END;
  812. reader.RawNum (identifier.fingerprint);
  813. END ReadIdentifier;
  814. PROCEDURE ReadFixupPattern (VAR pattern: FixupPattern);
  815. BEGIN
  816. reader.RawNum (pattern.offset);
  817. reader.RawNum (pattern.bits);
  818. END ReadFixupPattern;
  819. PROCEDURE ReadPattern(VAR pattern: Pattern);
  820. VAR i: LONGINT;
  821. BEGIN
  822. ReadValueIdentifier (pattern.mode, modes);
  823. reader.RawNum (pattern.scale);
  824. reader.RawNum (pattern.patterns);
  825. IF (pattern.pattern = NIL) OR (LEN (pattern.pattern) < pattern.patterns) THEN
  826. NEW (pattern.pattern, pattern.patterns);
  827. END;
  828. FOR i := 0 TO pattern.patterns - 1 DO
  829. ReadFixupPattern (pattern.pattern[i]);
  830. END;
  831. END ReadPattern;
  832. PROCEDURE ReadPatch(VAR patch: Patch);
  833. BEGIN
  834. reader.RawNum(patch.displacement);
  835. reader.RawNum(patch.offset);
  836. END ReadPatch;
  837. PROCEDURE ReadFixup (VAR fixup: Fixup);
  838. VAR i: LONGINT;
  839. BEGIN
  840. ReadIdentifier (fixup.identifier);
  841. IF fixup.pattern = NIL THEN NEW(fixup.pattern) END;
  842. ReadPattern(fixup.pattern);
  843. reader.RawNum (fixup.patches);
  844. IF fixup.patches > 0 THEN
  845. IF (fixup.patch = NIL) OR (LEN (fixup.patch) < fixup.patches) THEN
  846. NEW (fixup.patch, fixup.patches);
  847. END;
  848. FOR i := 0 TO fixup.patches - 1 DO
  849. ReadPatch (fixup.patch[i]);
  850. END;
  851. END;
  852. END ReadFixup;
  853. PROCEDURE ReadAlias (VAR alias: Alias);
  854. VAR i: LONGINT;
  855. BEGIN
  856. ReadIdentifier (alias.identifier);
  857. reader.RawNum (alias.offset);
  858. END ReadAlias;
  859. PROCEDURE ReadSegment(): BOOLEAN;
  860. VAR len,offset,bits: LONGINT; c: CHAR;
  861. segment: ARRAY 128 OF CHAR;
  862. received: LONGINT;
  863. BEGIN
  864. reader.RawNum(len);
  865. IF len = 0 THEN RETURN FALSE END;
  866. reader.RawNum(offset); offset := offset * ByteSize;
  867. WHILE len > LEN(segment) DO
  868. reader.Bytes(segment, 0, LEN(segment), received);
  869. ASSERT(received = LEN(segment));
  870. section.bits.SetBytes(offset, LEN(segment), segment);
  871. DEC(len, received);
  872. INC(offset, received*ByteSize);
  873. END;
  874. IF size MOD 8 # 0 THEN
  875. reader.Bytes(segment, 0, len-1, received);
  876. ASSERT(received = len-1);
  877. section.bits.SetBytes(offset, received, segment);
  878. DEC(len, received);
  879. INC(offset, received*ByteSize);
  880. (* last byte: only part of a byte *)
  881. reader.Char(c);
  882. section.bits.SetBits (offset, MIN (ByteSize, size - offset), ORD(c));
  883. ELSE
  884. reader.Bytes(segment, 0, len, received);
  885. ASSERT(received = len);
  886. section.bits.SetBytes(offset, received, segment);
  887. END;
  888. RETURN TRUE
  889. END ReadSegment;
  890. BEGIN
  891. reader.Char(ch); ASSERT(ch = 1X);
  892. ReadValueIdentifier (section.type, categories);
  893. ReadIdentifier (section.identifier);
  894. reader.RawNum (section.unit);
  895. ReadValueIdentifier(relocatibility, relocatabilities);
  896. section.fixed := relocatibility = Fixed;
  897. reader.RawNum (section.alignment);
  898. reader.RawNum (section.priority);
  899. reader.RawNum (section.aliases);
  900. reader.RawNum (section.fixups);
  901. reader.RawNum (size); size := size * section.unit;
  902. IF (section.aliases > 0) &((section.alias = NIL) OR (LEN (section.alias) < section.aliases)) THEN
  903. NEW (section.alias, section.aliases);
  904. END;
  905. FOR i := 0 TO section.aliases - 1 DO
  906. ReadAlias (section.alias[i]);
  907. END;
  908. IF (section.fixups > 0) & ((section.fixup = NIL) OR (LEN (section.fixup) < section.fixups)) THEN
  909. NEW (section.fixup, section.fixups);
  910. END;
  911. FOR i := 0 TO section.fixups - 1 DO
  912. ReadFixup (section.fixup[i]);
  913. END;
  914. IF section.bits # NIL THEN
  915. section.bits.Resize (size);
  916. section.bits.Zero();
  917. ELSE
  918. NEW (section.bits, size);
  919. END;
  920. WHILE ReadSegment() DO
  921. END;
  922. END ReadSectionBinary;
  923. PROCEDURE ReadSection*(reader: Streams.Reader; VAR section: Section; binary: BOOLEAN; poolMap: PoolMap);
  924. BEGIN
  925. IF binary THEN
  926. ReadSectionBinary(reader,section,poolMap)
  927. ELSE
  928. ReadSectionTextual(reader,section);
  929. END
  930. END ReadSection;
  931. PROCEDURE WriteSection*(writer: Streams.Writer; CONST section: Section; binary: BOOLEAN; poolMap: PoolMap);
  932. VAR pos: LONGINT;
  933. BEGIN
  934. pos := writer.Pos();
  935. IF binary THEN
  936. WriteSectionBinary(writer,section, poolMap)
  937. ELSE
  938. WriteSectionTextual(writer,section)
  939. END;
  940. INC(statSections); INC(statSectionsTotalSize, writer.Pos()-pos);
  941. END WriteSection;
  942. PROCEDURE SetFixups*(VAR section: Section; fixups: LONGINT; fixup: Fixups);
  943. BEGIN
  944. section.fixups := fixups;
  945. section.fixup := fixup;
  946. END SetFixups;
  947. PROCEDURE SetAliases*(VAR section: Section; aliases: LONGINT; alias: Aliases);
  948. BEGIN
  949. section.aliases := aliases;
  950. section.alias := alias;
  951. END SetAliases;
  952. PROCEDURE AddPatch*(VAR patches: LONGINT; VAR patch: Patches; disp, ofs: LONGINT);
  953. VAR newPatch: Patches; newPatches:LONGINT; i: LONGINT;
  954. BEGIN
  955. FOR i := 0 TO patches-1 DO
  956. ASSERT(patch[i].offset # ofs);
  957. END;
  958. newPatches := patches+1;
  959. IF (patch = NIL) OR (LEN(patch) < newPatches) THEN
  960. NEW(newPatch, 2*newPatches);
  961. FOR i := 0 TO patches-1 DO
  962. newPatch[i].offset := patch[i].offset;
  963. newPatch[i].displacement := patch[i].displacement;
  964. END;
  965. patch := newPatch;
  966. END;
  967. patch[patches].offset := ofs;
  968. patch[patches].displacement := disp;
  969. patches := newPatches;
  970. END AddPatch;
  971. PROCEDURE SameFixupPattern(patterns: LONGINT; left, right: FixupPatterns): BOOLEAN;
  972. VAR i: LONGINT;
  973. BEGIN
  974. FOR i := 0 TO patterns-1 DO
  975. IF (left[i].offset # right[i].offset) OR (left[i].bits # right[i].bits) THEN RETURN FALSE END;
  976. END;
  977. RETURN TRUE
  978. END SameFixupPattern;
  979. PROCEDURE SamePattern(left, right: Pattern): BOOLEAN;
  980. BEGIN
  981. RETURN (left.mode = right.mode) & (left.scale = right.scale) & (left.patterns = right.patterns) & SameFixupPattern(left.patterns, left.pattern, right.pattern);
  982. END SamePattern;
  983. PROCEDURE HasPattern(pat: Pattern; mode, scale: LONGINT; patterns: LONGINT; pattern: FixupPatterns): BOOLEAN;
  984. BEGIN
  985. RETURN (pat.mode = mode) & (pat.scale = scale) & (pat.patterns = patterns) & SameFixupPattern(patterns, pat.pattern, pattern);
  986. END HasPattern;
  987. (*
  988. PROCEDURE AddPatch(VAR patches: LONGINT; VAR patch: Patches; mode: INTEGER; displacement, scale: LONGINT; patterns: LONGINT; pattern: FixupPatterns; offset: LONGINT);
  989. VAR i: LONGINT; newPatches: LONGINT; newPatch: Patches; len: LONGINT;
  990. BEGIN
  991. FOR i := 0 TO patches-1 DO
  992. len := LEN(patch);
  993. ASSERT(patch # NIL,101);
  994. ASSERT(LEN(patch) > i,102);
  995. IF (patch[i].mode = mode) & (patch[i].displacement = displacement) & (patch[i].scale = scale) & (patch[i].patterns = patterns) & SamePattern(patterns, patch[i].pattern, pattern) THEN
  996. AddOffset(patch[i].offsets, patch[i].offset, offset);
  997. RETURN
  998. END;
  999. END;
  1000. newPatches := patches+1;
  1001. IF (patch = NIL) OR (LEN(patch) < newPatches) THEN
  1002. ASSERT(newPatches > 0);
  1003. NEW(newPatch, 2*newPatches);
  1004. FOR i := 0 TO patches-1 DO
  1005. newPatch[i] := patch[i];
  1006. (*
  1007. CopyPatch(patch[i], newPatch[i]);
  1008. *)
  1009. END;
  1010. patch := newPatch;
  1011. END;
  1012. ASSERT(LEN(patch) > patches);
  1013. patch[patches].mode := mode;
  1014. patch[patches].displacement := displacement;
  1015. patch[patches].patterns := patterns;
  1016. patch[patches].pattern := pattern;
  1017. patch[patches].offsets := 0;
  1018. patch[patches].offset := NIL;
  1019. AddOffset(patch[patches].offsets, patch[patches].offset, offset);
  1020. patches := newPatches;
  1021. (* increase size and add *)
  1022. END AddPatch;
  1023. *)
  1024. PROCEDURE AddFixup*(VAR fixups: LONGINT; VAR fixup: Fixups; CONST name: SegmentedName; fingerprint: LONGINT; mode: INTEGER; scale: LONGINT; patterns: LONGINT; pattern: FixupPatterns): LONGINT;
  1025. VAR i: LONGINT; newFixups, index: LONGINT; newFixup: Fixups;
  1026. BEGIN
  1027. FOR i := 0 TO fixups-1 DO
  1028. IF (fixup[i].identifier.fingerprint = fingerprint) & (name =fixup[i].identifier.name) & HasPattern(fixup[i].pattern, mode, scale, patterns, pattern) THEN
  1029. RETURN i
  1030. END;
  1031. END;
  1032. newFixups := fixups+1;
  1033. IF (fixup = NIL) OR (LEN(fixup) < newFixups) THEN
  1034. NEW(newFixup, MAX(2*newFixups,32));
  1035. FOR i := 0 TO fixups-1 DO
  1036. newFixup[i] := fixup[i];
  1037. (*CopyFixup(fixup[i], newFixup[i]);*)
  1038. END;
  1039. fixup := newFixup;
  1040. END;
  1041. fixup[fixups].identifier.name := name;
  1042. fixup[fixups].identifier.fingerprint := fingerprint;
  1043. NEW(fixup[fixups].pattern);
  1044. fixup[fixups].pattern.scale := scale;
  1045. fixup[fixups].pattern.mode := mode;
  1046. fixup[fixups].pattern.patterns := patterns;
  1047. fixup[fixups].pattern.pattern := pattern;
  1048. index := fixups;
  1049. fixups := newFixups;
  1050. (* increase size and add *)
  1051. RETURN index;
  1052. END AddFixup;
  1053. PROCEDURE AddAlias*(VAR aliases: LONGINT; VAR alias: Aliases; CONST name: SegmentedName; fingerprint, offset: LONGINT): LONGINT;
  1054. VAR i: LONGINT; newAliases, index: LONGINT; newAlias: Aliases;
  1055. BEGIN
  1056. newAliases := aliases+1;
  1057. IF (alias = NIL) OR (LEN(alias) < newAliases) THEN
  1058. NEW(newAlias, MAX(2*newAliases,32));
  1059. FOR i := 0 TO aliases-1 DO
  1060. newAlias[i] := alias[i];
  1061. (*CopyAlias(alias[i], newAlias[i]);*)
  1062. END;
  1063. alias := newAlias;
  1064. END;
  1065. alias[aliases].identifier.name := name;
  1066. alias[aliases].identifier.fingerprint := fingerprint;
  1067. alias[aliases].offset := offset;
  1068. index := aliases;
  1069. aliases := newAliases;
  1070. (* increase size and add *)
  1071. RETURN index;
  1072. END AddAlias;
  1073. PROCEDURE StringToSegmentedName*(CONST name: ARRAY OF CHAR; VAR segmentedName: SegmentedName);
  1074. VAR i,j,segment: LONGINT; n: SectionName;
  1075. BEGIN
  1076. (* convert a string of the form A.B.C.suffix to [S(A), S(B), S(C), S(suffix)] *)
  1077. segment := 0; i := 0;
  1078. WHILE (segment < LEN(segmentedName)) DO
  1079. j := 0;
  1080. WHILE (name[i] # 0X) & (name[i] # ".") DO
  1081. n[j] := name[i]; INC(i); INC(j);
  1082. END;
  1083. IF j > 0 THEN
  1084. IF segment = LEN(segmentedName)-1 THEN
  1085. WHILE (name[i] # 0X) DO n[j] := name[i]; INC(i); INC(j); END;
  1086. END;
  1087. n[j] := 0X; StringPool.GetIndex(n,segmentedName[segment]);
  1088. ELSE
  1089. segmentedName[segment] := -1
  1090. END;
  1091. IF name[i] = "." THEN INC(i) END;
  1092. INC(segment);
  1093. END;
  1094. END StringToSegmentedName;
  1095. PROCEDURE SegmentedNameToString*(CONST segmentedName: SegmentedName; VAR name: ARRAY OF CHAR);
  1096. VAR i,j, segment: LONGINT; n: SectionName;
  1097. BEGIN
  1098. i := 0; segment := 0;
  1099. WHILE (segment < LEN(segmentedName)) DO
  1100. IF segmentedName[segment] >= 0 THEN
  1101. IF segment > 0 THEN name[i] := "."; INC(i) END;
  1102. StringPool.GetString(segmentedName[segment],n);
  1103. j := 0;
  1104. WHILE n[j] # 0X DO
  1105. name[i] := n[j]; INC(i); INC(j);
  1106. END;
  1107. END;
  1108. INC(segment);
  1109. END;
  1110. name[i] := 0X;
  1111. END SegmentedNameToString;
  1112. (* result = 0 : equal strings, result < 0: s1 before s2, result > 0 : s1 after s2 (alphanumerically) *)
  1113. PROCEDURE CompareSegmentedNames*(CONST s1, s2: SegmentedName): LONGINT;
  1114. VAR n1, n2: SectionName; index: LONGINT; ch1, ch2: CHAR;
  1115. BEGIN
  1116. SegmentedNameToString(s1,n1);
  1117. SegmentedNameToString(s2,n2);
  1118. index := 0;
  1119. ch1 := n1[index];
  1120. ch2 := n2[index];
  1121. WHILE (ch1 # 0X) & (ch1 = ch2) DO
  1122. INC(index);
  1123. ch1 := n1[index];
  1124. ch2 := n2[index];
  1125. END;
  1126. RETURN ORD(ch1) - ORD(ch2);
  1127. END CompareSegmentedNames;
  1128. OPERATOR "="*(CONST l,r: SegmentedName): BOOLEAN;
  1129. VAR i: LONGINT;
  1130. BEGIN
  1131. 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]);
  1132. END "=";
  1133. OPERATOR "="*(CONST l,r: Identifier): BOOLEAN;
  1134. BEGIN
  1135. RETURN (l.name = r.name) & (r.fingerprint = l.fingerprint)
  1136. END "=";
  1137. OPERATOR "#"*(CONST l,r: Identifier): BOOLEAN;
  1138. BEGIN
  1139. RETURN (l.name # r.name) OR (r.fingerprint # l.fingerprint)
  1140. END "#";
  1141. OPERATOR ":="*(VAR l: SegmentedName; CONST r: ARRAY OF CHAR);
  1142. BEGIN
  1143. StringToSegmentedName(r, l)
  1144. END ":=";
  1145. OPERATOR ":="*(VAR l: ARRAY OF CHAR; CONST r: SegmentedName);
  1146. BEGIN
  1147. SegmentedNameToString(r, l)
  1148. END ":=";
  1149. OPERATOR "="*(CONST l: SegmentedName; CONST r: ARRAY OF CHAR): BOOLEAN;
  1150. VAR i,j,segment: LONGINT; n: SectionName;
  1151. BEGIN
  1152. i := 0; segment := 0;
  1153. WHILE (segment < LEN(l)) DO
  1154. IF l[segment] < 0 THEN
  1155. RETURN r[i] = 0X
  1156. ELSE
  1157. IF (segment>0) THEN
  1158. IF (r[i] # ".") THEN RETURN FALSE END;
  1159. INC(i);
  1160. END;
  1161. StringPool.GetString(l[segment], n);
  1162. j := 0;
  1163. WHILE (r[i] = n[j]) & (n[j] # 0X) & (r[i] # 0X) DO
  1164. INC(i); INC(j);
  1165. END;
  1166. IF n[j] # 0X THEN RETURN FALSE END;
  1167. END;
  1168. INC(segment);
  1169. END;
  1170. RETURN r[i] = 0X;
  1171. END "=";
  1172. OPERATOR "="*(CONST l: ARRAY OF CHAR; r: SegmentedName): BOOLEAN;
  1173. BEGIN
  1174. RETURN r = l
  1175. END "=";
  1176. OPERATOR "#"*(CONST l: SegmentedName; CONST r: ARRAY OF CHAR): BOOLEAN;
  1177. BEGIN RETURN ~(l=r)
  1178. END "#";
  1179. OPERATOR "#"*(CONST l: ARRAY OF CHAR; r: SegmentedName): BOOLEAN;
  1180. BEGIN
  1181. RETURN ~(r=l)
  1182. END "#";
  1183. OPERATOR "#"*(CONST l,r: SegmentedName): BOOLEAN;
  1184. VAR i: LONGINT;
  1185. BEGIN
  1186. 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]);
  1187. END "#";
  1188. PROCEDURE Statistics*;
  1189. VAR sections: LONGINT; sectionsContentSize: LONGINT;
  1190. BEGIN
  1191. TRACE(statHeaders, statHeadersSize);
  1192. TRACE(statFixups, statFixupsSize, statFixupPatterns, statFixupPatches);
  1193. TRACE(statAliases, statAliasesSize);
  1194. TRACE(statSegments, statSegmentsSize, statSegmentsSize DIV MAX(1,statSegments));
  1195. TRACE(statCodeSections, statCodeSectionsSize);
  1196. TRACE(statDataSections, statDataSectionsSize);
  1197. TRACE(statConstSections, statConstSectionsSize);
  1198. TRACE(statInitSections, statInitSectionsSize);
  1199. TRACE(statBodySections, statBodySectionsSize);
  1200. sections := statCodeSections + statDataSections + statConstSections + statInitSections + statBodySections;
  1201. sectionsContentSize := statCodeSectionsSize + statDataSectionsSize + statConstSectionsSize + statInitSectionsSize + statBodySectionsSize;
  1202. TRACE(sections, sectionsContentSize);
  1203. TRACE(statSections, statSectionsTotalSize);
  1204. END Statistics;
  1205. PROCEDURE ResetStatistics*;
  1206. BEGIN
  1207. statHeaders := 0; statHeadersSize := 0;
  1208. statFixups := 0; statFixupsSize := 0; statFixupPatterns := 0; statFixupPatches := 0;
  1209. statAliases := 0; statAliasesSize := 0;
  1210. statSegments := 0; statSegmentsSize := 0;
  1211. statCodeSections := 0; statCodeSectionsSize := 0;
  1212. statDataSections := 0; statDataSectionsSize := 0;
  1213. statConstSections := 0; statConstSectionsSize := 0;
  1214. statInitSections := 0; statInitSectionsSize := 0;
  1215. statBodySections := 0; statBodySectionsSize := 0;
  1216. statSections := 0; statSectionsTotalSize := 0;
  1217. END ResetStatistics;
  1218. BEGIN
  1219. categories[Code] := "code";
  1220. categories[InitCode] := "initcode";
  1221. categories[BodyCode] := "bodycode";
  1222. categories[Data] := "data";
  1223. categories[Const] := "const";
  1224. modes[Absolute] := "abs";
  1225. modes[Relative] := "rel";
  1226. relocatabilities[Fixed] := "fixed";
  1227. relocatabilities[Aligned] := "aligned";
  1228. ResetStatistics;
  1229. END ObjectFile.
  1230. ObjectFile.Test