ObjectFile.Mod 39 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376
  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)) & (segmentedName[segment] >= 0) DO
  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. INC(segment);
  1107. END;
  1108. name[i] := 0X;
  1109. END SegmentedNameToString;
  1110. (* result = 0 : equal strings, result < 0: s1 before s2, result > 0 : s1 after s2 (alphanumerically) *)
  1111. PROCEDURE CompareSegmentedNames*(CONST s1, s2: SegmentedName): LONGINT;
  1112. VAR n1, n2: SectionName; index: LONGINT; ch1, ch2: CHAR;
  1113. BEGIN
  1114. SegmentedNameToString(s1,n1);
  1115. SegmentedNameToString(s2,n2);
  1116. index := 0;
  1117. ch1 := n1[index];
  1118. ch2 := n2[index];
  1119. WHILE (ch1 # 0X) & (ch1 = ch2) DO
  1120. INC(index);
  1121. ch1 := n1[index];
  1122. ch2 := n2[index];
  1123. END;
  1124. RETURN ORD(ch1) - ORD(ch2);
  1125. END CompareSegmentedNames;
  1126. OPERATOR "="*(CONST l,r: SegmentedName): BOOLEAN;
  1127. VAR i: LONGINT;
  1128. BEGIN
  1129. 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]);
  1130. END "=";
  1131. OPERATOR "="*(CONST l,r: Identifier): BOOLEAN;
  1132. BEGIN
  1133. RETURN (l.name = r.name) & (r.fingerprint = l.fingerprint)
  1134. END "=";
  1135. OPERATOR "#"*(CONST l,r: Identifier): BOOLEAN;
  1136. BEGIN
  1137. RETURN (l.name # r.name) OR (r.fingerprint # l.fingerprint)
  1138. END "#";
  1139. OPERATOR ":="*(VAR l: SegmentedName; CONST r: ARRAY OF CHAR);
  1140. BEGIN
  1141. StringToSegmentedName(r, l)
  1142. END ":=";
  1143. OPERATOR ":="*(VAR l: ARRAY OF CHAR; CONST r: SegmentedName);
  1144. BEGIN
  1145. SegmentedNameToString(r, l)
  1146. END ":=";
  1147. OPERATOR "="*(CONST l: SegmentedName; CONST r: ARRAY OF CHAR): BOOLEAN;
  1148. VAR i,j,segment: LONGINT; n: SectionName;
  1149. BEGIN
  1150. i := 0; segment := 0;
  1151. WHILE (segment < LEN(l)) DO
  1152. IF l[segment] < 0 THEN
  1153. RETURN r[i] = 0X
  1154. ELSE
  1155. IF (segment>0) THEN
  1156. IF (r[i] # ".") THEN RETURN FALSE END;
  1157. INC(i);
  1158. END;
  1159. StringPool.GetString(l[segment], n);
  1160. j := 0;
  1161. WHILE (r[i] = n[j]) & (n[j] # 0X) & (r[i] # 0X) DO
  1162. INC(i); INC(j);
  1163. END;
  1164. IF n[j] # 0X THEN RETURN FALSE END;
  1165. END;
  1166. INC(segment);
  1167. END;
  1168. RETURN r[i] = 0X;
  1169. END "=";
  1170. OPERATOR "="*(CONST l: ARRAY OF CHAR; r: SegmentedName): BOOLEAN;
  1171. BEGIN
  1172. RETURN r = l
  1173. END "=";
  1174. OPERATOR "#"*(CONST l: SegmentedName; CONST r: ARRAY OF CHAR): BOOLEAN;
  1175. BEGIN RETURN ~(l=r)
  1176. END "#";
  1177. OPERATOR "#"*(CONST l: ARRAY OF CHAR; r: SegmentedName): BOOLEAN;
  1178. BEGIN
  1179. RETURN ~(r=l)
  1180. END "#";
  1181. OPERATOR "#"*(CONST l,r: SegmentedName): BOOLEAN;
  1182. VAR i: LONGINT;
  1183. BEGIN
  1184. 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]);
  1185. END "#";
  1186. PROCEDURE Statistics*;
  1187. VAR sections: LONGINT; sectionsContentSize: LONGINT;
  1188. BEGIN
  1189. TRACE(statHeaders, statHeadersSize);
  1190. TRACE(statFixups, statFixupsSize, statFixupPatterns, statFixupPatches);
  1191. TRACE(statAliases, statAliasesSize);
  1192. TRACE(statSegments, statSegmentsSize, statSegmentsSize DIV MAX(1,statSegments));
  1193. TRACE(statCodeSections, statCodeSectionsSize);
  1194. TRACE(statDataSections, statDataSectionsSize);
  1195. TRACE(statConstSections, statConstSectionsSize);
  1196. TRACE(statInitSections, statInitSectionsSize);
  1197. TRACE(statBodySections, statBodySectionsSize);
  1198. sections := statCodeSections + statDataSections + statConstSections + statInitSections + statBodySections;
  1199. sectionsContentSize := statCodeSectionsSize + statDataSectionsSize + statConstSectionsSize + statInitSectionsSize + statBodySectionsSize;
  1200. TRACE(sections, sectionsContentSize);
  1201. TRACE(statSections, statSectionsTotalSize);
  1202. END Statistics;
  1203. PROCEDURE ResetStatistics*;
  1204. BEGIN
  1205. statHeaders := 0; statHeadersSize := 0;
  1206. statFixups := 0; statFixupsSize := 0; statFixupPatterns := 0; statFixupPatches := 0;
  1207. statAliases := 0; statAliasesSize := 0;
  1208. statSegments := 0; statSegmentsSize := 0;
  1209. statCodeSections := 0; statCodeSectionsSize := 0;
  1210. statDataSections := 0; statDataSectionsSize := 0;
  1211. statConstSections := 0; statConstSectionsSize := 0;
  1212. statInitSections := 0; statInitSectionsSize := 0;
  1213. statBodySections := 0; statBodySectionsSize := 0;
  1214. statSections := 0; statSectionsTotalSize := 0;
  1215. END ResetStatistics;
  1216. BEGIN
  1217. categories[Code] := "code";
  1218. categories[InitCode] := "initcode";
  1219. categories[BodyCode] := "bodycode";
  1220. categories[Data] := "data";
  1221. categories[Const] := "const";
  1222. modes[Absolute] := "abs";
  1223. modes[Relative] := "rel";
  1224. relocatabilities[Fixed] := "fixed";
  1225. relocatabilities[Aligned] := "aligned";
  1226. ResetStatistics;
  1227. END ObjectFile.
  1228. ObjectFile.Test