ObjectFile.Mod 39 KB

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