2
0

ObjectFile.Mod 39 KB

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