12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400 |
- MODULE ObjectFile; (* AUTHOR "negelef"; PURPOSE "Generic Object File Representation"; *)
- IMPORT Streams, BitSets, StringPool;
- CONST
- (* Fixup modes *)
- Absolute* = 0;
- Relative* = 1;
- (* Section categories *)
- (* code section categories, ordered by decreasing linking preference *)
- EntryCode*= 0; (* entry code sections provide the entry point for static linking, enry code runs before module initializer callers *)
- InitCode*=1; (* initcode sections provide the entry point for static linking. A static linker includes this sections, a dynamic linker wants to omit them *)
- ExitCode*=2; (* exit code sections close a statically linked code, are executed after all init code callers *)
- 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 *)
- Code*=4; (* normal executable code *)
- (* data section categories *)
- Data* = 5; (* data sections provide space for (global) variables *)
- Const* = 6; (* const sections are data sections that are immutable *)
- (* alignment types *)
- Aligned=0;
- Fixed=1;
- DefaultExtension* = ".Gof";
- SegmentedNameLength=8;
- TYPE
- Unit* = LONGINT;
- Bits* = LONGINT;
- SectionType = INTEGER;
- SegmentedName*= ARRAY SegmentedNameLength OF StringPool.Index;
- SectionName* = ARRAY 128 OF CHAR;
- (* FixupPattern = size (+|-) bits {size (+|-) bits}
- Example:
- fixupPattern = 0+8 -128+4 8-8 means
- store first 8 bits to offset 0
- leave out next 4 bits
- store next 8 bits to offset 8 in reverse order
- most frequently used are
- fixupPattern=0+8 : 8 bit fixup
- fixupPattern=0+16: 16 bit fixup
- fixupPattern=0+32: 32 bit fixup
- *)
- FixupPattern* = RECORD
- offset*, bits*: Bits;
- END;
- FixupPatterns*= POINTER TO ARRAY OF FixupPattern;
- Identifier*= RECORD
- name*: SegmentedName;
- fingerprint*: LONGINT;
- END;
- Pattern*= POINTER TO RECORD (* this is the same for many fixups *)
- mode-: INTEGER;
- scale-: Bits;
- patterns-: LONGINT;
- pattern-: FixupPatterns
- END;
- Patch*= RECORD
- offset-, displacement-: Unit;
- END;
- Patches*= POINTER TO ARRAY OF Patch;
- Fixup* = RECORD
- identifier*: Identifier;
- pattern-: Pattern;
- index*: LONGINT;
- patches*: LONGINT;
- patch*: Patches;
- END;
- Alias*= RECORD
- identifier*: Identifier;
- offset-: Unit
- END;
- Fixups*=POINTER TO ARRAY OF Fixup;
- Aliases*= POINTER TO ARRAY OF Alias;
- Section* = RECORD
- type*: SectionType;
- identifier*: Identifier;
- unit*: Bits;
- fixed*: BOOLEAN;
- alignment*: Unit;
- fixups-: LONGINT;
- fixup-: Fixups;
- aliases-: LONGINT;
- alias-: Aliases;
- bits*: BitSets.BitSet;
- END;
- PoolMapItem= RECORD key, value: LONGINT END;
- PoolMapArray*=POINTER TO ARRAY OF PoolMapItem;
- PoolMap*=OBJECT
- VAR
- table: PoolMapArray;
- size: LONGINT;
- used: LONGINT;
- maxLoadFactor: REAL;
- writer: Streams.Writer;
- (* Interface *)
- PROCEDURE & Init* (initialSize: LONGINT);
- BEGIN
- ASSERT(initialSize > 2);
- NEW(table, initialSize);
- size := initialSize;
- used := 0;
- maxLoadFactor := 0.75;
- Clear;
- Put(0,0); (* empty string mapped one-to-one *)
- END Init;
- PROCEDURE Put(key, value: LONGINT);
- VAR hash: LONGINT;
- BEGIN
- ASSERT(used < size);
- ASSERT(key >= 0);
- hash := HashValue(key);
- IF table[hash].key <0 THEN
- INC(used, 1);
- table[hash].key := key;
- ELSE
- ASSERT(table[hash].key = key);
- END;
- table[hash].value := value;
- IF (used / size) > maxLoadFactor THEN Grow END;
- END Put;
- PROCEDURE Get*(key: LONGINT):LONGINT;
- BEGIN
- IF key = -1 THEN
- RETURN -1
- ELSE
- RETURN table[HashValue(key)].value;
- END
- END Get;
- PROCEDURE Has*(key: LONGINT):BOOLEAN;
- BEGIN
- RETURN table[HashValue(key)].key = key;
- END Has;
- PROCEDURE Clear*;
- VAR i: LONGINT;
- BEGIN FOR i := 0 TO size - 1 DO table[i].key := -1; END; END Clear;
- (* only correctly working, if NIL key cannot be entered *)
- PROCEDURE HashValue(key: LONGINT):LONGINT;
- VAR value, h, i: LONGINT;
- BEGIN
- value := key;
- i := 0;
- h := value MOD size;
- REPEAT
- value := (h + i) MOD size;
- INC(i);
- UNTIL((table[value].key < 0) OR (table[value].key = key) OR (i > size));
- ASSERT((table[value].key <0) OR (table[value].key = key));
- RETURN value;
- END HashValue;
- PROCEDURE Grow;
- VAR oldTable: PoolMapArray; oldSize, i: LONGINT; key: LONGINT;
- BEGIN
- oldSize := size;
- oldTable := table;
- Init(size*2);
- FOR i := 0 TO oldSize-1 DO
- key := oldTable[i].key;
- IF key >=0 THEN
- Put(key, oldTable[i].value);
- END;
- END;
- END Grow;
- (** read map and produce Local --> Global **)
- PROCEDURE Read*(reader: Streams.Reader);
- VAR i,j,pos,size,value: LONGINT; ch: CHAR;name: SectionName;
- BEGIN
- pos := 1;
- reader.RawString(name);
- WHILE name[0] # 0X DO
- StringPool.GetIndex(name,value);
- Put(pos,value);
- INC(pos);
- reader.RawString(name);
- END;
- END Read;
- (** write global --> local map **)
- PROCEDURE PutGlobal*(key: LONGINT);
- VAR name: SectionName;
- BEGIN
- IF ~Has(key) THEN
- Put(key, used);
- StringPool.GetString(key, name);
- writer.RawString(name);
- END;
- END PutGlobal;
- PROCEDURE PutSegmentedName*(CONST name: SegmentedName);
- VAR i: LONGINT;
- BEGIN
- FOR i := 0 TO LEN(name)-1 DO
- IF name[i] < 0 THEN RETURN END;
- PutGlobal(name[i]);
- END;
- END PutSegmentedName;
- PROCEDURE BeginWriting*(w: Streams.Writer);
- BEGIN
- writer := w;
- END BeginWriting;
- PROCEDURE EndWriting*;
- BEGIN
- writer.RawString("");
- writer := NIL;
- END EndWriting;
- END PoolMap;
-
- NameList*= POINTER TO ARRAY OF SegmentedName;
- VAR
- categories: ARRAY 8 OF ARRAY 10 OF CHAR;
- modes: ARRAY 2 OF ARRAY 4 OF CHAR;
- relocatabilities: ARRAY 2 OF ARRAY 8 OF CHAR;
- statHeaders, statHeadersSize: LONGINT;
- statFixups, statFixupsSize, statFixupPatterns, statFixupPatches: LONGINT;
- statAliases, statAliasesSize: LONGINT;
- statSegments, statSegmentsSize: LONGINT;
- statCodeSections, statCodeSectionsSize: LONGINT;
- statDataSections, statDataSectionsSize: LONGINT;
- statConstSections, statConstSectionsSize: LONGINT;
- statInitSections, statInitSectionsSize: LONGINT;
- statBodySections, statBodySectionsSize: LONGINT;
- statSections, statSectionsTotalSize: LONGINT;
- PROCEDURE IsCode* (type: SectionType): BOOLEAN;
- BEGIN RETURN (type IN {InitCode, BodyCode, Code})
- END IsCode;
- PROCEDURE Matches*(CONST this, that: Identifier): BOOLEAN;
- BEGIN
- IF (this.fingerprint # 0) & (this.fingerprint = that.fingerprint) THEN RETURN TRUE
- ELSE RETURN (this.name = that.name)
- END;
- END Matches;
- PROCEDURE CopyIdentifier(CONST source: Identifier; VAR dest: Identifier);
- BEGIN
- dest.name := source.name; dest.fingerprint := source.fingerprint
- END CopyIdentifier;
- PROCEDURE CopyPattern( source: Pattern; VAR dest: Pattern);
- VAR i: LONGINT;
- BEGIN
- NEW(dest);
- dest.mode := source.mode;
- dest.scale := source.scale;
- dest.patterns := source.patterns;
- NEW(dest.pattern, dest.patterns);
- FOR i := 0 TO LEN(dest.pattern)-1 DO
- dest.pattern[i] := source.pattern[i];
- END;
- END CopyPattern;
- PROCEDURE CopyPatches(sourcePatches: LONGINT; source: Patches; VAR destPatches: LONGINT; VAR dest: Patches);
- VAR i: LONGINT;
- BEGIN
- destPatches := sourcePatches;
- NEW(dest, destPatches);
- FOR i := 0 TO destPatches-1 DO
- dest[i] := source[i]
- END;
- END CopyPatches;
- PROCEDURE CopyFixup*(source: Fixup; VAR dest: Fixup);
- VAR i: LONGINT;
- BEGIN
- CopyIdentifier(source.identifier, dest.identifier);
- CopyPattern(source.pattern, dest.pattern);
- CopyPatches(source.patches, source.patch, dest.patches, dest.patch);
- END CopyFixup;
- PROCEDURE CopyAlias*(CONST source: Alias; VAR dest: Alias);
- VAR i: LONGINT;
- BEGIN
- CopyIdentifier(source.identifier, dest.identifier);
- dest.offset := source.offset;
- END CopyAlias;
- PROCEDURE CopySection* (CONST source: Section; VAR dest: Section);
- VAR i: LONGINT;
- BEGIN
- dest.type := source.type;
- dest.identifier := source.identifier;
- dest.unit := source.unit;
- dest.fixed := source.fixed;
- dest.alignment := source.alignment;
- dest.fixups:= source.fixups;
- dest.aliases := source.aliases;
- NEW (dest.fixup, dest.fixups);
- FOR i := 0 TO dest.fixups - 1 DO
- CopyFixup(source.fixup[i], dest.fixup[i]);
- END;
- NEW (dest.alias, dest.aliases);
- FOR i := 0 TO dest.aliases - 1 DO
- CopyAlias(source.alias[i], dest.alias[i]);
- END;
- NEW (dest.bits, source.bits.GetSize ());
- BitSets.CopyBits (source.bits, 0, dest.bits, 0, source.bits.GetSize ());
- END CopySection;
-
- PROCEDURE InitSection*(VAR dest: Section);
- BEGIN
- dest.type := 0;
- dest.identifier.name := "";
- dest.identifier.fingerprint := 0;
- dest.unit := 0;
- dest.fixed := FALSE;
- dest.alignment := 0;
- dest.fixups:= 0;
- dest.aliases := 0;
- dest.fixup := NIL;
- dest.alias := NIL;
- dest.bits := NIL;
- END InitSection;
- PROCEDURE NibbleToCharacter* (value: LONGINT): CHAR;
- BEGIN
- IF value >= 10 THEN
- RETURN CHR ((ORD ('A') - 10) + value);
- ELSE
- RETURN CHR (ORD ('0') + value);
- END;
- END NibbleToCharacter;
- PROCEDURE CharacterToNibble* (char: CHAR): LONGINT;
- BEGIN
- IF ORD (char) >= ORD ('A') THEN
- RETURN ORD (char) - (ORD ('A') - 10);
- ELSE
- RETURN ORD (char) - ORD ('0');
- END;
- END CharacterToNibble;
- PROCEDURE WriteSectionTextual (writer: Streams.Writer; CONST section: Section);
- CONST Separator = ' '; Tab = 09X;
- VAR i,offset,start, len: LONGINT; size: Bits; bits: LONGINT;
- PROCEDURE WriteValueIdentifier (value: INTEGER; CONST identifiers: ARRAY OF ARRAY OF CHAR);
- BEGIN
- writer.String (identifiers[value]);
- END WriteValueIdentifier;
- PROCEDURE WriteFixupPattern (CONST pattern: FixupPattern);
- BEGIN
- writer.Int (pattern.offset, 0);
- writer.Char (Separator);
- writer.Int (pattern.bits, 0);
- END WriteFixupPattern;
- PROCEDURE WriteIdentifier(CONST identifier: Identifier);
- VAR name: SectionName;
- BEGIN
- SegmentedNameToString(identifier.name, name);
- writer.String (name);
- writer.Char (Separator);
- writer.Int (identifier.fingerprint, 0);
- END WriteIdentifier;
- PROCEDURE WritePattern(pattern: Pattern);
- VAR i: LONGINT;
- BEGIN
- WriteValueIdentifier (pattern.mode, modes);
- writer.Char (Separator);
- writer.Int (pattern.scale, 0);
- writer.Char (Separator);
- writer.Int (pattern.patterns, 0);
- writer.Char (Separator);
- FOR i := 0 TO pattern.patterns - 1 DO
- WriteFixupPattern (pattern.pattern[i]);
- writer.Char (Separator);
- END;
- END WritePattern;
- PROCEDURE WritePatch (CONST patch: Patch);
- BEGIN
- writer.Int (patch.displacement, 0);
- writer.Char (Separator);
- writer.Int (patch.offset, 0);
- END WritePatch;
- PROCEDURE WriteFixup (CONST fixup: Fixup);
- VAR i: LONGINT;
- BEGIN
- WriteIdentifier(fixup.identifier);
- writer.Char (Separator);
- WritePattern(fixup.pattern);
- writer.Char(Separator);
- writer.Int(fixup.patches,1);
- writer.Char(Separator);
- FOR i := 0 TO fixup.patches-1 DO
- WritePatch(fixup.patch[i]);
- writer.Char (Separator);
- END;
- END WriteFixup;
- PROCEDURE WriteAlias (CONST alias: Alias);
- VAR i: LONGINT;
- BEGIN
- WriteIdentifier(alias.identifier);
- writer.Char (Separator);
- writer.Int (alias.offset, 0);
- END WriteAlias;
- PROCEDURE Zeros(offset: LONGINT): LONGINT;
- VAR zeros: LONGINT;
- BEGIN
- zeros := 0;
- WHILE (offset < size) & (section.bits.GetBits(offset, MIN(4, size-offset)) = 0) DO
- INC(zeros);
- INC(offset,4);
- END;
- RETURN zeros
- END Zeros;
- PROCEDURE GetSegment(VAR offset, start, len: LONGINT): BOOLEAN;
- VAR zeros: LONGINT;
- BEGIN
- INC(offset, Zeros(offset)*4);
- start := offset;
- len := 0;
- WHILE (offset < size) DO
- zeros := Zeros(offset);
- INC(offset, zeros*4);
- IF (zeros > 8) OR (offset >= size) THEN
- RETURN TRUE;
- ELSE
- INC(len, zeros*4);
- INC(len,4); INC(offset,4); (* non-zero element *)
- END;
- END;
- RETURN len > 0;
- END GetSegment;
- PROCEDURE WriteSegment(offset,len: LONGINT); (* offset in bits *)
- VAR bits: LONGINT; first: BOOLEAN;
- BEGIN
- ASSERT(len MOD 4 = 0); ASSERT(offset MOD 4 = 0);
- len := len DIV 4;
- writer.Int(len,1); writer.Char(Separator); writer.Int(offset DIV 4,1); writer.Char(Separator);
- WHILE len > 0 DO
- bits := section.bits.GetBits(offset, MIN(4, size-offset));
- writer.Char(NibbleToCharacter(bits));
- INC(offset, 4);
- DEC(len);
- END;
- writer.Ln;
- END WriteSegment;
- BEGIN
- IF section.type > Const THEN RETURN END; (* ignore exotic sections *)
- WriteValueIdentifier (section.type, categories);
- writer.Char (Separator);
- WriteIdentifier(section.identifier);
- writer.Char (Separator);
- writer.Int (section.unit, 0);
- writer.Char (Separator);
- IF section.fixed THEN WriteValueIdentifier(Fixed,relocatabilities) ELSE WriteValueIdentifier(Aligned,relocatabilities) END;
- writer.Char (Separator);
- writer.Int (section.alignment, 0);
- writer.Char (Separator);
- writer.Int (section.aliases, 0);
- writer.Char (Separator);
- writer.Int (section.fixups, 0);
- writer.Char (Separator);
- size := section.bits.GetSize ();
- writer.Int (size DIV section.unit, 1);
- ASSERT(size MOD section.unit = 0);
- FOR i := 0 TO section.aliases - 1 DO
- writer.Ln; writer.Char (Tab); WriteAlias (section.alias[i]);
- END;
- FOR i := 0 TO section.fixups - 1 DO
- writer.Ln; writer.Char (Tab); WriteFixup (section.fixup[i]);
- END;
- writer.Ln;
- offset := 0;
- WHILE GetSegment(offset, start, len) DO
- WriteSegment(start, len)
- END;
- writer.Int(0,1); writer.Ln;
- writer.Ln;
- END WriteSectionTextual;
- PROCEDURE ReadSectionTextual (reader: Streams.Reader; version: LONGINT; VAR section: Section);
- VAR i, size: LONGINT; char: CHAR; relocatibility: INTEGER; priority: LONGINT;
- PROCEDURE ReadValueIdentifier (VAR value: INTEGER; CONST identifiers: ARRAY OF ARRAY OF CHAR);
- VAR identifier: ARRAY 10 OF CHAR;
- BEGIN
- value := 0;
- reader.SkipWhitespace; reader.String (identifier);
- WHILE (value # LEN (identifiers)) & (identifier # identifiers[value]) DO INC (value); END;
- IF value = LEN (identifiers) THEN reader.res := Streams.FormatError; END;
- END ReadValueIdentifier;
- PROCEDURE ReadFixupPattern (VAR pattern: FixupPattern);
- BEGIN
- reader.SkipWhitespace; reader.Int (pattern.offset, FALSE);
- reader.SkipWhitespace; reader.Int (pattern.bits, FALSE);
- END ReadFixupPattern;
- PROCEDURE ReadIdentifier(VAR identifier: Identifier);
- VAR name: SectionName;
- BEGIN
- reader.SkipWhitespace;
- reader.String(name);
- StringToSegmentedName(name,identifier.name);
- reader.SkipWhitespace; reader.Int (identifier.fingerprint,FALSE);
- END ReadIdentifier;
- PROCEDURE ReadPattern(VAR pattern: Pattern);
- VAR i: LONGINT;
- BEGIN
- reader.SkipWhitespace;
- ReadValueIdentifier (pattern.mode, modes);
- reader.SkipWhitespace; reader.Int (pattern.scale, FALSE);
- reader.SkipWhitespace; reader.Int (pattern.patterns, FALSE);
- IF (pattern.pattern = NIL) OR (LEN (pattern.pattern) < pattern.patterns) THEN
- NEW (pattern.pattern, pattern.patterns);
- END;
- FOR i := 0 TO pattern.patterns - 1 DO
- ReadFixupPattern (pattern.pattern[i]);
- END;
- END ReadPattern;
- PROCEDURE ReadPatch (VAR patch: Patch);
- BEGIN
- reader.SkipWhitespace; reader.Int (patch.displacement, FALSE);
- reader.SkipWhitespace; reader.Int (patch.offset, FALSE);
- END ReadPatch;
- PROCEDURE ReadFixup (VAR fixup: Fixup);
- VAR i: LONGINT;
- BEGIN
- reader.SkipWhitespace; ReadIdentifier (fixup.identifier);
- IF fixup.pattern = NIL THEN NEW(fixup.pattern) END;
- reader.SkipWhitespace; ReadPattern(fixup.pattern);
- reader.SkipWhitespace; reader.Int (fixup.patches, FALSE);
- IF (fixup.patch = NIL) OR (LEN (fixup.patch) < fixup.patches) THEN
- NEW (fixup.patch, fixup.patches);
- END;
- FOR i := 0 TO fixup.patches - 1 DO
- ReadPatch (fixup.patch[i]);
- END;
- END ReadFixup;
- PROCEDURE ReadAlias (VAR alias: Alias);
- VAR i: LONGINT;
- BEGIN
- reader.SkipWhitespace; ReadIdentifier (alias.identifier);
- reader.SkipWhitespace; reader.Int(alias.offset,FALSE);
- END ReadAlias;
- PROCEDURE ReadSegment(): BOOLEAN;
- VAR len,offset: LONGINT;
- BEGIN
- reader.Int(len,FALSE);
- reader.SkipWhitespace;
- IF len = 0 THEN RETURN FALSE END;
- reader.Int(offset,FALSE); offset := offset * 4;
- reader.SkipWhitespace;
- WHILE len > 0 DO
- reader.Char (char);
- section.bits.SetBits (offset, MIN (4, size - offset), CharacterToNibble (char));
- DEC(len); INC(offset,4);
- END;
- RETURN TRUE
- END ReadSegment;
- BEGIN
- ReadValueIdentifier (section.type, categories);
- ReadIdentifier (section.identifier);
- reader.SkipWhitespace; reader.Int (section.unit, FALSE);
- ReadValueIdentifier(relocatibility, relocatabilities);
- section.fixed := relocatibility = Fixed;
- reader.SkipWhitespace; reader.Int (section.alignment, FALSE);
- IF version < 5 THEN
- reader.SkipWhitespace; reader.Int (priority, FALSE);
- IF section.type = InitCode THEN
- IF priority = -4 THEN section.type := EntryCode;
- ELSIF priority = -1 THEN section.type := ExitCode;
- END;
- END;
- END;
- reader.SkipWhitespace; reader.Int (section.aliases, FALSE);
- reader.SkipWhitespace; reader.Int (section.fixups, FALSE);
- reader.SkipWhitespace; reader.Int (size, FALSE); size := size * section.unit;
- IF (section.aliases > 0) & ((section.alias = NIL) OR (LEN (section.alias) < section.aliases)) THEN
- NEW (section.alias, section.aliases);
- END;
- FOR i := 0 TO section.aliases - 1 DO
- ReadAlias (section.alias[i]);
- END;
- IF (section.fixups > 0) & ((section.fixup = NIL) OR (LEN (section.fixup) < section.fixups)) THEN
- NEW (section.fixup, section.fixups);
- END;
- FOR i := 0 TO section.fixups - 1 DO
- ReadFixup (section.fixup[i]);
- ASSERT(section.fixup[i].patch # NIL);
- END;
- IF section.bits # NIL THEN
- section.bits.Resize (size);
- section.bits.Zero();
- ELSE
- NEW (section.bits, size);
- END;
- REPEAT
- reader.SkipWhitespace()
- UNTIL ~ReadSegment()
- END ReadSectionTextual;
- PROCEDURE ReadNameList*(reader: Streams.Reader; VAR nameList: NameList; binary: BOOLEAN; poolMap: PoolMap);
- VAR i,len,num: LONGINT; name: ARRAY 256 OF CHAR;
- PROCEDURE ReadIdentifier(VAR name: SegmentedName);
- (*VAR name: SectionName;*)
- VAR i,num: LONGINT;
- BEGIN
- i := 0;
- REPEAT
- reader.RawNum(num);
- name[i] := poolMap.Get(num);
- INC(i);
- UNTIL (i = LEN(name)) OR (num < 0);
- WHILE i < LEN(name) DO
- name[i] := -1; INC(i);
- END;
- END ReadIdentifier;
- BEGIN
- IF binary THEN
- reader.RawNum(len);
- NEW(nameList, len);
- FOR i := 0 TO len-1 DO
- ReadIdentifier(nameList[i]);
- END;
- ELSE
- reader.SkipWhitespace;
- reader.Int(len,FALSE);
- NEW(nameList, len);
- FOR i := 0 TO len-1 DO
- reader.SkipWhitespace;
- reader.String(name);
- nameList[i] := name;
- END;
- END;
- END ReadNameList;
- PROCEDURE WriteNameList*(writer: Streams.Writer; nameList: NameList; binary: BOOLEAN; poolMap: PoolMap);
- VAR i,len,num: LONGINT; name: ARRAY 256 OF CHAR;
- CONST Separator = ' ';
- PROCEDURE WriteIdentifier(CONST name: SegmentedName);
- VAR i,num: LONGINT;
- BEGIN
- i := 0;
- REPEAT
- num := poolMap.Get(name[i]);
- writer.RawNum(num);
- INC(i);
- UNTIL (i = LEN(name)) OR (num < 0);
- END WriteIdentifier;
- BEGIN
- IF nameList = NIL THEN len := 0
- ELSE len := LEN(nameList);
- END;
- IF binary THEN
- writer.RawNum(len);
- FOR i := 0 TO len-1 DO
- WriteIdentifier(nameList[i]);
- END;
- ELSE
- writer.Int(len,0);
- FOR i := 0 TO len-1 DO
- name := nameList[i];
- writer.Char(Separator);
- writer.String(name);
- END;
- writer.Ln;
- END;
- END WriteNameList;
-
- PROCEDURE WriteSectionBinary (writer: Streams.Writer; CONST section: Section; poolMap: PoolMap);
- VAR pos, i, offset, start, len: LONGINT; size: Bits; bits: LONGINT; name: ARRAY 256 OF CHAR;
- CONST ByteSize=8;
- PROCEDURE WriteValueIdentifier (value: INTEGER; CONST identifiers: ARRAY OF ARRAY OF CHAR);
- BEGIN
- writer.RawNum(value);
- (*
- writer.RawString (identifiers[value]);
- *)
- END WriteValueIdentifier;
- PROCEDURE WriteFixupPattern (CONST pattern: FixupPattern);
- BEGIN
- writer.RawNum (pattern.offset);
- writer.RawNum (pattern.bits);
- INC(statFixupPatterns);
- END WriteFixupPattern;
- PROCEDURE WriteIdentifier(CONST identifier: Identifier);
- VAR i,num: LONGINT;
- BEGIN
- i := 0;
- REPEAT
- num := poolMap.Get(identifier.name[i]);
- writer.RawNum(num);
- INC(i);
- UNTIL (i = LEN(identifier.name)) OR (num < 0);
- writer.RawNum (identifier.fingerprint);
- END WriteIdentifier;
- PROCEDURE WritePattern(pattern: Pattern);
- VAR i: LONGINT;
- BEGIN
- WriteValueIdentifier (pattern.mode, modes);
- writer.RawNum (pattern.scale);
- writer.RawNum (pattern.patterns);
- FOR i := 0 TO pattern.patterns - 1 DO
- WriteFixupPattern (pattern.pattern[i]);
- END;
- END WritePattern;
- PROCEDURE WritePatch (CONST patch: Patch);
- BEGIN
- writer.RawNum (patch.displacement);
- writer.RawNum (patch.offset);
- INC(statFixupPatches);
- END WritePatch;
- PROCEDURE WriteFixup (CONST fixup: Fixup);
- VAR i: LONGINT;
- BEGIN
- INC(statFixups);
- WriteIdentifier(fixup.identifier);
- WritePattern(fixup.pattern);
- writer.RawNum(fixup.patches);
- ASSERT(fixup.patches > 0);
- FOR i := 0 TO fixup.patches-1 DO
- WritePatch(fixup.patch[i]);
- END;
- END WriteFixup;
- PROCEDURE WriteAlias (CONST alias: Alias);
- VAR i: LONGINT;
- BEGIN
- WriteIdentifier(alias.identifier);
- writer.RawNum(alias.offset);
- END WriteAlias;
- PROCEDURE Zeros(offset: LONGINT): LONGINT;
- VAR zeros: LONGINT;
- BEGIN
- WHILE (offset < size) & (section.bits.GetBits(offset, MIN(ByteSize, size-offset)) = 0) DO
- INC(zeros);
- INC(offset,ByteSize);
- END;
- RETURN zeros
- END Zeros;
- PROCEDURE GetSegment(VAR offset, start, len: LONGINT): BOOLEAN;
- VAR zeros: LONGINT;
- BEGIN
- INC(offset, Zeros(offset)*ByteSize);
- start := offset;
- len := 0;
- WHILE (offset < size) DO
- zeros := Zeros(offset);
- INC(offset, zeros*ByteSize);
- IF (zeros > 2) (* best value evaluated with statisitc over whole release *) OR (offset >= size) THEN
- RETURN TRUE;
- ELSE
- ASSERT(offset < size);
- INC(len, zeros*ByteSize);
- INC(len,ByteSize); INC(offset,ByteSize); (* non-zero element *)
- END;
- END;
- RETURN len > 0;
- END GetSegment;
- PROCEDURE WriteSegment(offset,len: LONGINT); (* offset in bits *)
- VAR bits: LONGINT; first: BOOLEAN; pos: LONGINT;
- BEGIN
- pos := writer.Pos();
- ASSERT(len > 0);
- ASSERT(len MOD ByteSize = 0); ASSERT(offset MOD ByteSize = 0);
- len := len DIV ByteSize;
- writer.RawNum(len); writer.RawNum(offset DIV ByteSize);
- WHILE len > 0 DO
- bits := section.bits.GetBits(offset, MIN(ByteSize, size-offset));
- INC(offset, ByteSize);
- DEC(len);
- writer.Char(CHR(bits));
- END;
- INC(statSegments); INC(statSegmentsSize, writer.Pos()-pos);
- END WriteSegment;
- BEGIN
- (* header *)
- pos := writer.Pos();
- IF section.type > Const THEN RETURN END; (* ignore exotic sections *)
- writer.Char(1X);
- WriteValueIdentifier (section.type, categories);
- WriteIdentifier(section.identifier);
- writer.RawNum (section.unit);
- IF section.fixed THEN WriteValueIdentifier(Fixed,relocatabilities) ELSE WriteValueIdentifier(Aligned,relocatabilities) END;
- writer.RawNum (section.alignment);
- writer.RawNum (section.aliases);
- writer.RawNum (section.fixups);
- size := section.bits.GetSize ();
- writer.RawNum (size DIV section.unit);
- INC(statHeaders);
- INC(statHeadersSize, writer.Pos()-pos);
- (* aliases *)
- pos := writer.Pos();
- ASSERT(size MOD section.unit = 0);
- FOR i := 0 TO section.aliases - 1 DO
- WriteAlias (section.alias[i]);
- END;
- INC(statAliases, section.aliases);
- INC(statAliasesSize, writer.Pos()-pos);
- (* fixups *)
- pos := writer.Pos();
- FOR i := 0 TO section.fixups - 1 DO
- WriteFixup (section.fixup[i]);
- END;
- INC(statFixups, section.fixups);
- INC(statFixupsSize, writer.Pos()-pos);
- (* code / data *)
- pos := writer.Pos();
- offset := 0;
- WHILE GetSegment(offset, start, len) DO
- WriteSegment(start, len);
- END;
- writer.RawNum(0);
- CASE section.type OF
- InitCode: INC(statInitSections); INC(statInitSectionsSize, writer.Pos()-pos);
- |BodyCode: INC(statBodySections); INC(statBodySectionsSize, writer.Pos()-pos);
- |Code: INC(statCodeSections); INC(statCodeSectionsSize, writer.Pos()-pos);
- |Data: INC(statDataSections); INC(statDataSectionsSize, writer.Pos()-pos);
- |Const: INC(statConstSections); INC(statConstSectionsSize, writer.Pos()-pos);
- ELSE (* ignored *)
- END;
- END WriteSectionBinary;
- PROCEDURE ReadSectionBinary (reader: Streams.Reader; version: LONGINT; VAR section: Section; poolMap: PoolMap);
- VAR i, size: LONGINT; char: CHAR; relocatibility: INTEGER; num: LONGINT; ch: CHAR; priority: LONGINT;
- CONST ByteSize=8;
- PROCEDURE ReadValueIdentifier (VAR value: INTEGER; CONST identifiers: ARRAY OF ARRAY OF CHAR);
- (* VAR identifier: ARRAY 10 OF CHAR; *)
- VAR num: LONGINT;
- BEGIN
- reader.RawNum(num);
- value := SHORT(num);
- (*
- value := 0;
- reader.RawString (identifier);
- WHILE (value # LEN (identifiers)) & (identifier # identifiers[value]) DO INC (value); END;
- IF value = LEN (identifiers) THEN reader.res := Streams.FormatError; END;
- *)
- END ReadValueIdentifier;
- PROCEDURE ReadIdentifier(VAR identifier: Identifier);
- (*VAR name: SectionName;*)
- VAR i,num: LONGINT;
- BEGIN
- i := 0;
- REPEAT
- reader.RawNum(num);
- identifier.name[i] := poolMap.Get(num);
- INC(i);
- UNTIL (i = LEN(identifier.name)) OR (num < 0);
- WHILE i < LEN(identifier.name) DO
- identifier.name[i] := -1; INC(i);
- END;
- reader.RawNum (identifier.fingerprint);
- END ReadIdentifier;
- PROCEDURE ReadFixupPattern (VAR pattern: FixupPattern);
- BEGIN
- reader.RawNum (pattern.offset);
- reader.RawNum (pattern.bits);
- END ReadFixupPattern;
- PROCEDURE ReadPattern(VAR pattern: Pattern);
- VAR i: LONGINT;
- BEGIN
- ReadValueIdentifier (pattern.mode, modes);
- reader.RawNum (pattern.scale);
- reader.RawNum (pattern.patterns);
- IF (pattern.pattern = NIL) OR (LEN (pattern.pattern) < pattern.patterns) THEN
- NEW (pattern.pattern, pattern.patterns);
- END;
- FOR i := 0 TO pattern.patterns - 1 DO
- ReadFixupPattern (pattern.pattern[i]);
- END;
- END ReadPattern;
- PROCEDURE ReadPatch(VAR patch: Patch);
- BEGIN
- reader.RawNum(patch.displacement);
- reader.RawNum(patch.offset);
- END ReadPatch;
- PROCEDURE ReadFixup (VAR fixup: Fixup);
- VAR i: LONGINT;
- BEGIN
- ReadIdentifier (fixup.identifier);
- IF fixup.pattern = NIL THEN NEW(fixup.pattern) END;
- ReadPattern(fixup.pattern);
- reader.RawNum (fixup.patches);
- IF fixup.patches > 0 THEN
- IF (fixup.patch = NIL) OR (LEN (fixup.patch) < fixup.patches) THEN
- NEW (fixup.patch, fixup.patches);
- END;
- FOR i := 0 TO fixup.patches - 1 DO
- ReadPatch (fixup.patch[i]);
- END;
- END;
- END ReadFixup;
- PROCEDURE ReadAlias (VAR alias: Alias);
- VAR i: LONGINT;
- BEGIN
- ReadIdentifier (alias.identifier);
- reader.RawNum (alias.offset);
- END ReadAlias;
- PROCEDURE ReadSegment(): BOOLEAN;
- VAR len,offset,bits: LONGINT; c: CHAR;
- segment: ARRAY 128 OF CHAR;
- received: LONGINT;
- BEGIN
- reader.RawNum(len);
- IF len = 0 THEN RETURN FALSE END;
- reader.RawNum(offset); offset := offset * ByteSize;
- WHILE len > LEN(segment) DO
- reader.Bytes(segment, 0, LEN(segment), received);
- ASSERT(received = LEN(segment));
- section.bits.SetBytes(offset, LEN(segment), segment);
- DEC(len, received);
- INC(offset, received*ByteSize);
- END;
- IF size MOD 8 # 0 THEN
- reader.Bytes(segment, 0, len-1, received);
- ASSERT(received = len-1);
- section.bits.SetBytes(offset, received, segment);
- DEC(len, received);
- INC(offset, received*ByteSize);
- (* last byte: only part of a byte *)
- reader.Char(c);
- section.bits.SetBits (offset, MIN (ByteSize, size - offset), ORD(c));
- ELSE
- reader.Bytes(segment, 0, len, received);
- ASSERT(received = len);
- section.bits.SetBytes(offset, received, segment);
- END;
- RETURN TRUE
- END ReadSegment;
- BEGIN
- reader.Char(ch); ASSERT(ch = 1X);
- ReadValueIdentifier (section.type, categories);
- ReadIdentifier (section.identifier);
- reader.RawNum (section.unit);
- ReadValueIdentifier(relocatibility, relocatabilities);
- section.fixed := relocatibility = Fixed;
- reader.RawNum (section.alignment);
- IF version < 5 THEN
- reader.RawNum (priority);
- CASE section.type OF
- 0: section.type := InitCode;
- |1:section.type := BodyCode;
- |2:section.type := Code;
- |3:section.type := Data;
- |4:section.type := Const;
- END;
- IF section.type = InitCode THEN
- IF priority = -4 THEN section.type := EntryCode;
- ELSIF priority = -1 THEN section.type := ExitCode;
- END;
- END;
- END;
- reader.RawNum (section.aliases);
- reader.RawNum (section.fixups);
- reader.RawNum (size); size := size * section.unit;
- IF (section.aliases > 0) &((section.alias = NIL) OR (LEN (section.alias) < section.aliases)) THEN
- NEW (section.alias, section.aliases);
- END;
- FOR i := 0 TO section.aliases - 1 DO
- ReadAlias (section.alias[i]);
- END;
- IF (section.fixups > 0) & ((section.fixup = NIL) OR (LEN (section.fixup) < section.fixups)) THEN
- NEW (section.fixup, section.fixups);
- END;
- FOR i := 0 TO section.fixups - 1 DO
- ReadFixup (section.fixup[i]);
- END;
- IF section.bits # NIL THEN
- section.bits.Resize (size);
- section.bits.Zero();
- ELSE
- NEW (section.bits, size);
- END;
- WHILE ReadSegment() DO
- END;
- END ReadSectionBinary;
- PROCEDURE ReadSection*(reader: Streams.Reader; version: LONGINT; VAR section: Section; binary: BOOLEAN; poolMap: PoolMap);
- BEGIN
- IF binary THEN
- ReadSectionBinary(reader,version, section,poolMap)
- ELSE
- ReadSectionTextual(reader,version,section);
- END
- END ReadSection;
- PROCEDURE WriteSection*(writer: Streams.Writer; CONST section: Section; binary: BOOLEAN; poolMap: PoolMap);
- VAR pos: LONGINT;
- BEGIN
- pos := writer.Pos();
- IF binary THEN
- WriteSectionBinary(writer,section, poolMap)
- ELSE
- WriteSectionTextual(writer,section)
- END;
- INC(statSections); INC(statSectionsTotalSize, writer.Pos()-pos);
- END WriteSection;
- PROCEDURE SetFixups*(VAR section: Section; fixups: LONGINT; fixup: Fixups);
- BEGIN
- section.fixups := fixups;
- section.fixup := fixup;
- END SetFixups;
- PROCEDURE SetAliases*(VAR section: Section; aliases: LONGINT; alias: Aliases);
- BEGIN
- section.aliases := aliases;
- section.alias := alias;
- END SetAliases;
- PROCEDURE AddPatch*(VAR patches: LONGINT; VAR patch: Patches; disp, ofs: LONGINT);
- VAR newPatch: Patches; newPatches:LONGINT; i: LONGINT;
- BEGIN
- FOR i := 0 TO patches-1 DO
- ASSERT(patch[i].offset # ofs);
- END;
- newPatches := patches+1;
- IF (patch = NIL) OR (LEN(patch) < newPatches) THEN
- NEW(newPatch, 2*newPatches);
- FOR i := 0 TO patches-1 DO
- newPatch[i].offset := patch[i].offset;
- newPatch[i].displacement := patch[i].displacement;
- END;
- patch := newPatch;
- END;
- patch[patches].offset := ofs;
- patch[patches].displacement := disp;
- patches := newPatches;
- END AddPatch;
- PROCEDURE SameFixupPattern(patterns: LONGINT; left, right: FixupPatterns): BOOLEAN;
- VAR i: LONGINT;
- BEGIN
- FOR i := 0 TO patterns-1 DO
- IF (left[i].offset # right[i].offset) OR (left[i].bits # right[i].bits) THEN RETURN FALSE END;
- END;
- RETURN TRUE
- END SameFixupPattern;
- PROCEDURE SamePattern(left, right: Pattern): BOOLEAN;
- BEGIN
- RETURN (left.mode = right.mode) & (left.scale = right.scale) & (left.patterns = right.patterns) & SameFixupPattern(left.patterns, left.pattern, right.pattern);
- END SamePattern;
- PROCEDURE HasPattern(pat: Pattern; mode, scale: LONGINT; patterns: LONGINT; pattern: FixupPatterns): BOOLEAN;
- BEGIN
- RETURN (pat.mode = mode) & (pat.scale = scale) & (pat.patterns = patterns) & SameFixupPattern(patterns, pat.pattern, pattern);
- END HasPattern;
- (*
- PROCEDURE AddPatch(VAR patches: LONGINT; VAR patch: Patches; mode: INTEGER; displacement, scale: LONGINT; patterns: LONGINT; pattern: FixupPatterns; offset: LONGINT);
- VAR i: LONGINT; newPatches: LONGINT; newPatch: Patches; len: LONGINT;
- BEGIN
- FOR i := 0 TO patches-1 DO
- len := LEN(patch);
- ASSERT(patch # NIL,101);
- ASSERT(LEN(patch) > i,102);
- IF (patch[i].mode = mode) & (patch[i].displacement = displacement) & (patch[i].scale = scale) & (patch[i].patterns = patterns) & SamePattern(patterns, patch[i].pattern, pattern) THEN
- AddOffset(patch[i].offsets, patch[i].offset, offset);
- RETURN
- END;
- END;
- newPatches := patches+1;
- IF (patch = NIL) OR (LEN(patch) < newPatches) THEN
- ASSERT(newPatches > 0);
- NEW(newPatch, 2*newPatches);
- FOR i := 0 TO patches-1 DO
- newPatch[i] := patch[i];
- (*
- CopyPatch(patch[i], newPatch[i]);
- *)
- END;
- patch := newPatch;
- END;
- ASSERT(LEN(patch) > patches);
- patch[patches].mode := mode;
- patch[patches].displacement := displacement;
- patch[patches].patterns := patterns;
- patch[patches].pattern := pattern;
- patch[patches].offsets := 0;
- patch[patches].offset := NIL;
- AddOffset(patch[patches].offsets, patch[patches].offset, offset);
- patches := newPatches;
- (* increase size and add *)
- END AddPatch;
- *)
- PROCEDURE AddFixup*(VAR fixups: LONGINT; VAR fixup: Fixups; CONST name: SegmentedName; fingerprint: LONGINT; mode: INTEGER; scale: LONGINT; patterns: LONGINT; pattern: FixupPatterns): LONGINT;
- VAR i: LONGINT; newFixups, index: LONGINT; newFixup: Fixups;
- BEGIN
- FOR i := 0 TO fixups-1 DO
- IF (fixup[i].identifier.fingerprint = fingerprint) & (name =fixup[i].identifier.name) & HasPattern(fixup[i].pattern, mode, scale, patterns, pattern) THEN
- RETURN i
- END;
- END;
- newFixups := fixups+1;
- IF (fixup = NIL) OR (LEN(fixup) < newFixups) THEN
- NEW(newFixup, MAX(2*newFixups,32));
- FOR i := 0 TO fixups-1 DO
- newFixup[i] := fixup[i];
- (*CopyFixup(fixup[i], newFixup[i]);*)
- END;
- fixup := newFixup;
- END;
- fixup[fixups].identifier.name := name;
- fixup[fixups].identifier.fingerprint := fingerprint;
- NEW(fixup[fixups].pattern);
- fixup[fixups].pattern.scale := scale;
- fixup[fixups].pattern.mode := mode;
- fixup[fixups].pattern.patterns := patterns;
- fixup[fixups].pattern.pattern := pattern;
- index := fixups;
- fixups := newFixups;
- (* increase size and add *)
- RETURN index;
- END AddFixup;
- PROCEDURE AddAlias*(VAR aliases: LONGINT; VAR alias: Aliases; CONST name: SegmentedName; fingerprint, offset: LONGINT): LONGINT;
- VAR i: LONGINT; newAliases, index: LONGINT; newAlias: Aliases;
- BEGIN
- newAliases := aliases+1;
- IF (alias = NIL) OR (LEN(alias) < newAliases) THEN
- NEW(newAlias, MAX(2*newAliases,32));
- FOR i := 0 TO aliases-1 DO
- newAlias[i] := alias[i];
- (*CopyAlias(alias[i], newAlias[i]);*)
- END;
- alias := newAlias;
- END;
- alias[aliases].identifier.name := name;
- alias[aliases].identifier.fingerprint := fingerprint;
- alias[aliases].offset := offset;
- index := aliases;
- aliases := newAliases;
- (* increase size and add *)
- RETURN index;
- END AddAlias;
- PROCEDURE StringToSegmentedName*(CONST name: ARRAY OF CHAR; VAR segmentedName: SegmentedName);
- VAR i,j,segment: LONGINT; n: SectionName;
- BEGIN
- (* convert a string of the form A.B.C.suffix to [S(A), S(B), S(C), S(suffix)] *)
- segment := 0; i := 0;
- WHILE (segment < LEN(segmentedName)) DO
- j := 0;
- WHILE (name[i] # 0X) & (name[i] # ".") DO
- n[j] := name[i]; INC(i); INC(j);
- END;
- IF j > 0 THEN
- IF segment = LEN(segmentedName)-1 THEN
- WHILE (name[i] # 0X) DO n[j] := name[i]; INC(i); INC(j); END;
- END;
- n[j] := 0X; StringPool.GetIndex(n,segmentedName[segment]);
- ELSE
- segmentedName[segment] := -1
- END;
- IF name[i] = "." THEN INC(i) END;
- INC(segment);
- END;
- END StringToSegmentedName;
- PROCEDURE SegmentedNameToString*(CONST segmentedName: SegmentedName; VAR name: ARRAY OF CHAR);
- VAR i,j, segment: LONGINT; n: SectionName;
- BEGIN
- i := 0; segment := 0;
- WHILE (segment < LEN(segmentedName)) & (segmentedName[segment] >= 0) DO
- IF segment > 0 THEN name[i] := "."; INC(i) END;
- StringPool.GetString(segmentedName[segment],n);
- j := 0;
- WHILE n[j] # 0X DO
- name[i] := n[j]; INC(i); INC(j);
- END;
- INC(segment);
- END;
- name[i] := 0X;
- END SegmentedNameToString;
-
- (* result = 0 : equal strings, result < 0: s1 before s2, result > 0 : s1 after s2 (alphanumerically) *)
- PROCEDURE CompareSegmentedNames*(CONST s1, s2: SegmentedName): LONGINT;
- VAR n1, n2: SectionName; index: LONGINT; ch1, ch2: CHAR;
- BEGIN
- SegmentedNameToString(s1,n1);
- SegmentedNameToString(s2,n2);
- index := 0;
- ch1 := n1[index];
- ch2 := n2[index];
- WHILE (ch1 # 0X) & (ch1 = ch2) DO
- INC(index);
- ch1 := n1[index];
- ch2 := n2[index];
- END;
- RETURN ORD(ch1) - ORD(ch2);
- END CompareSegmentedNames;
- OPERATOR "="*(CONST l,r: SegmentedName): BOOLEAN;
- VAR i: LONGINT;
- BEGIN
- 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]);
- END "=";
- OPERATOR "="*(CONST l,r: Identifier): BOOLEAN;
- BEGIN
- RETURN (l.name = r.name) & (r.fingerprint = l.fingerprint)
- END "=";
- OPERATOR "#"*(CONST l,r: Identifier): BOOLEAN;
- BEGIN
- RETURN (l.name # r.name) OR (r.fingerprint # l.fingerprint)
- END "#";
- OPERATOR ":="*(VAR l: SegmentedName; CONST r: ARRAY OF CHAR);
- BEGIN
- StringToSegmentedName(r, l)
- END ":=";
- OPERATOR ":="*(VAR l: ARRAY OF CHAR; CONST r: SegmentedName);
- BEGIN
- SegmentedNameToString(r, l)
- END ":=";
- OPERATOR "="*(CONST l: SegmentedName; CONST r: ARRAY OF CHAR): BOOLEAN;
- VAR i,j,segment: LONGINT; n: SectionName;
- BEGIN
- i := 0; segment := 0;
- WHILE (segment < LEN(l)) DO
- IF l[segment] < 0 THEN
- RETURN r[i] = 0X
- ELSE
- IF (segment>0) THEN
- IF (r[i] # ".") THEN RETURN FALSE END;
- INC(i);
- END;
- StringPool.GetString(l[segment], n);
- j := 0;
- WHILE (r[i] = n[j]) & (n[j] # 0X) & (r[i] # 0X) DO
- INC(i); INC(j);
- END;
- IF n[j] # 0X THEN RETURN FALSE END;
- END;
- INC(segment);
- END;
- RETURN r[i] = 0X;
- END "=";
- OPERATOR "="*(CONST l: ARRAY OF CHAR; r: SegmentedName): BOOLEAN;
- BEGIN
- RETURN r = l
- END "=";
- OPERATOR "#"*(CONST l: SegmentedName; CONST r: ARRAY OF CHAR): BOOLEAN;
- BEGIN RETURN ~(l=r)
- END "#";
- OPERATOR "#"*(CONST l: ARRAY OF CHAR; r: SegmentedName): BOOLEAN;
- BEGIN
- RETURN ~(r=l)
- END "#";
- OPERATOR "#"*(CONST l,r: SegmentedName): BOOLEAN;
- VAR i: LONGINT;
- BEGIN
- 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]);
- END "#";
- PROCEDURE Statistics*;
- VAR sections: LONGINT; sectionsContentSize: LONGINT;
- BEGIN
- TRACE(statHeaders, statHeadersSize);
- TRACE(statFixups, statFixupsSize, statFixupPatterns, statFixupPatches);
- TRACE(statAliases, statAliasesSize);
- TRACE(statSegments, statSegmentsSize, statSegmentsSize DIV MAX(1,statSegments));
- TRACE(statCodeSections, statCodeSectionsSize);
- TRACE(statDataSections, statDataSectionsSize);
- TRACE(statConstSections, statConstSectionsSize);
- TRACE(statInitSections, statInitSectionsSize);
- TRACE(statBodySections, statBodySectionsSize);
- sections := statCodeSections + statDataSections + statConstSections + statInitSections + statBodySections;
- sectionsContentSize := statCodeSectionsSize + statDataSectionsSize + statConstSectionsSize + statInitSectionsSize + statBodySectionsSize;
- TRACE(sections, sectionsContentSize);
- TRACE(statSections, statSectionsTotalSize);
- END Statistics;
- PROCEDURE ResetStatistics*;
- BEGIN
- statHeaders := 0; statHeadersSize := 0;
- statFixups := 0; statFixupsSize := 0; statFixupPatterns := 0; statFixupPatches := 0;
- statAliases := 0; statAliasesSize := 0;
- statSegments := 0; statSegmentsSize := 0;
- statCodeSections := 0; statCodeSectionsSize := 0;
- statDataSections := 0; statDataSectionsSize := 0;
- statConstSections := 0; statConstSectionsSize := 0;
- statInitSections := 0; statInitSectionsSize := 0;
- statBodySections := 0; statBodySectionsSize := 0;
- statSections := 0; statSectionsTotalSize := 0;
- END ResetStatistics;
- BEGIN
- categories[Code] := "code";
- categories[EntryCode] := "entrycode";
- categories[InitCode] := "initcode";
- categories[ExitCode] := "exitcode";
- categories[BodyCode] := "bodycode";
- categories[Data] := "data";
- categories[Const] := "const";
- modes[Absolute] := "abs";
- modes[Relative] := "rel";
- relocatabilities[Fixed] := "fixed";
- relocatabilities[Aligned] := "aligned";
- ResetStatistics;
- END ObjectFile.
- ObjectFile.Test
|