initial commit
This commit is contained in:
slederer
commit
60db522e87
107 changed files with 36924 additions and 0 deletions
884
pcomp/sdis.pas
Normal file
884
pcomp/sdis.pas
Normal file
|
|
@ -0,0 +1,884 @@
|
|||
(* Copyright 2021-2024 Sebastian Lederer. See the file LICENSE.md for details *)
|
||||
program sdis;
|
||||
{$R+}
|
||||
{$MODE objfpc}
|
||||
type
|
||||
InputFileType = file of char;
|
||||
OutputFileType = text;
|
||||
|
||||
KeywordString = string[128];
|
||||
IdentString = string[80];
|
||||
|
||||
SymbolType = (ConstSymbol, LabelSymbol, SpecialSymbol);
|
||||
|
||||
|
||||
Symbol = record
|
||||
name:KeywordString;
|
||||
value:integer;
|
||||
typ:SymbolType;
|
||||
end;
|
||||
|
||||
HashEntry = record
|
||||
key:integer;
|
||||
data:IdentString;
|
||||
next:^HashEntry;
|
||||
end;
|
||||
|
||||
HashRef = ^HashEntry;
|
||||
HashBucket = ^HashEntry;
|
||||
HashTable = array [0..255] of HashBucket;
|
||||
|
||||
var infile:InputfileType;
|
||||
filename:string;
|
||||
pc:integer;
|
||||
symbolTable: HashTable;
|
||||
|
||||
procedure errorExit;
|
||||
begin
|
||||
close(infile);
|
||||
halt;
|
||||
end;
|
||||
|
||||
procedure errorExit2(message1, message2: string);
|
||||
begin
|
||||
writeln;
|
||||
writeln('Error: ', message1, ' ', message2);
|
||||
errorExit;
|
||||
end;
|
||||
|
||||
procedure openFile(var f:InputFileType;var filename:string);
|
||||
begin
|
||||
{$I-}
|
||||
assign(f, filename);
|
||||
reset(f);
|
||||
|
||||
if IOResult <> 0 then
|
||||
errorExit2('cannot open file ', filename);
|
||||
{$I+}
|
||||
end;
|
||||
|
||||
function readChar:char;
|
||||
var c:char;
|
||||
begin
|
||||
read(infile,c);
|
||||
readChar := c;
|
||||
end;
|
||||
|
||||
procedure readEol;
|
||||
var c:char;
|
||||
begin
|
||||
c := readChar;
|
||||
if c = #13 then
|
||||
begin
|
||||
c := readChar;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
function readBin(len:integer):integer;
|
||||
var i,v:integer;
|
||||
c:char;
|
||||
begin
|
||||
v := 0;
|
||||
for i := 1 to len do
|
||||
begin
|
||||
c := readChar;
|
||||
v := v shl 8;
|
||||
v := v or ord(c);
|
||||
end;
|
||||
readBin := v;
|
||||
end;
|
||||
|
||||
function readAsciiBin(len:integer):integer;
|
||||
var i:integer;
|
||||
w:integer;
|
||||
c:char;
|
||||
bits:integer;
|
||||
begin
|
||||
bits := len * 8;
|
||||
w := 0;
|
||||
for i := 1 to bits do
|
||||
begin
|
||||
w := w shl 1;
|
||||
c := readChar;
|
||||
if c = '1' then
|
||||
w := w or 1
|
||||
else
|
||||
if c = '0' then begin end;
|
||||
end;
|
||||
readAsciiBin := w;
|
||||
|
||||
(* read end of line *)
|
||||
if (pc and 3) = 2 then
|
||||
readEol;
|
||||
end;
|
||||
|
||||
function readBytes(len:integer):integer;
|
||||
var w:integer;
|
||||
c:char;
|
||||
i:integer;
|
||||
begin
|
||||
w := 0;
|
||||
for i := 1 to len do
|
||||
begin
|
||||
read(infile, c);
|
||||
w := (w shl 8) or ord(c);
|
||||
end;
|
||||
|
||||
readBytes := w;
|
||||
writeln('readBytes ',len, ': ', w);
|
||||
end;
|
||||
|
||||
function readInstruction:integer;
|
||||
begin
|
||||
(* readInstruction := readBytes(2); *)
|
||||
readInstruction := readBin(2);
|
||||
end;
|
||||
|
||||
function readWord:integer;
|
||||
begin
|
||||
readWord := readBin(4);
|
||||
end;
|
||||
|
||||
function convertHex(var digits:KeywordString):integer;
|
||||
var i,v,len:integer;
|
||||
c:char;
|
||||
begin
|
||||
len := length(digits);
|
||||
|
||||
i := 1;
|
||||
convertHex := 0;
|
||||
|
||||
while i <= len do
|
||||
begin
|
||||
convertHex := convertHex shl 4;
|
||||
c := UpCase(digits[i]);
|
||||
if (c >= 'A') and (c <= 'F') then
|
||||
v := ord(c) - ord('A') + 10
|
||||
else
|
||||
if (c >= '0') and (c <= '9') then
|
||||
v := ord(c) - ord('0')
|
||||
else
|
||||
errorExit2('invalid number',digits);
|
||||
convertHex := convertHex + v;
|
||||
i := i + 1;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure hexstr(value:integer;var output:string);
|
||||
var i:integer;
|
||||
nibble:integer;
|
||||
c:char;
|
||||
begin
|
||||
output := '00000000';
|
||||
|
||||
for i := 8 downto 1 do
|
||||
begin
|
||||
nibble := value and $F;
|
||||
if nibble > 9 then
|
||||
c := chr( ord('A') + nibble - 10)
|
||||
else
|
||||
c := chr( ord('0') + nibble);
|
||||
|
||||
output[i] := c;
|
||||
value := value shr 4;
|
||||
if value = 0 then break;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure writeHex(value:integer);
|
||||
var s:string;
|
||||
begin
|
||||
hexstr(value,s);
|
||||
write('$',s);
|
||||
end;
|
||||
|
||||
procedure printAsciiWord(w:integer);
|
||||
var i:integer;
|
||||
c:char;
|
||||
begin
|
||||
write('"');
|
||||
for i := 1 to 4 do
|
||||
begin
|
||||
c := chr(((w shr 24) and $FF));
|
||||
w := w shl 8;
|
||||
if (c < ' ') or (c > '~') then
|
||||
c := '.';
|
||||
write(c);
|
||||
end;
|
||||
write('"');
|
||||
end;
|
||||
|
||||
|
||||
{$R-}
|
||||
(* disable range checks for 32-bit hash functions *)
|
||||
|
||||
(* hash a 32-bit integer into an 8-bit integer *)
|
||||
function hashint(value:integer):integer;
|
||||
var i:integer;
|
||||
begin
|
||||
hashint := 0;
|
||||
value := value xor $B298AB49; (* some random 32-bit constant *)
|
||||
for i := 1 to 4 do
|
||||
begin
|
||||
hashint := hashint xor (value and $FF);
|
||||
value := value shr 8;
|
||||
end;
|
||||
end;
|
||||
|
||||
{$R+}
|
||||
|
||||
procedure putHashed(var t:HashTable;key:integer;var data:KeywordString);
|
||||
var i:integer;
|
||||
newEntry:^HashEntry;
|
||||
bucket:HashBucket;
|
||||
begin
|
||||
new(newEntry);
|
||||
newEntry^.data := data;
|
||||
newEntry^.key := key;
|
||||
|
||||
i := hashint(key);
|
||||
bucket := t[i];
|
||||
newEntry^.next := bucket;
|
||||
t[i] := newEntry;
|
||||
end;
|
||||
|
||||
function getHashed(var t:HashTable;key:integer):HashRef;
|
||||
var bucket:HashBucket;
|
||||
current:^HashEntry;
|
||||
found:boolean;
|
||||
begin
|
||||
getHashed := nil;
|
||||
bucket := t[hashint(key)];
|
||||
current := bucket;
|
||||
found := false;
|
||||
|
||||
while (current <> nil) and not found do
|
||||
begin
|
||||
if current^.key = key then
|
||||
begin
|
||||
getHashed := current;
|
||||
found := true;
|
||||
end;
|
||||
current := current^.next;
|
||||
end;
|
||||
end;
|
||||
|
||||
function getHashBucket(var t:HashTable;key:integer):HashRef;
|
||||
begin
|
||||
getHashBucket := t[hashint(key)];
|
||||
end;
|
||||
|
||||
procedure dumpHash(var t:HashTable);
|
||||
var i:integer;
|
||||
bucket:HashBucket;
|
||||
current:HashRef;
|
||||
begin
|
||||
for i := 0 to 255 do
|
||||
begin
|
||||
write('bucket ',i:4, ' ');
|
||||
bucket := t[i];
|
||||
current := bucket;
|
||||
while current <> nil do
|
||||
begin
|
||||
write(current^.key, ':', current^.data, ' ');
|
||||
current := current^.next;
|
||||
end;
|
||||
writeln;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure printEol;
|
||||
begin
|
||||
writeln;
|
||||
end;
|
||||
|
||||
procedure printHex(value:integer);
|
||||
var s:string[8];
|
||||
begin
|
||||
write('$');
|
||||
hexstr(value, s);
|
||||
write(s);
|
||||
end;
|
||||
|
||||
procedure printOperand(operand:integer);
|
||||
var sym:HashRef;
|
||||
begin
|
||||
sym := getHashed(symbolTable, operand);
|
||||
if sym <> nil then
|
||||
begin
|
||||
write(sym^.data);
|
||||
write(' ; ');
|
||||
end;
|
||||
|
||||
printHex(operand);
|
||||
end;
|
||||
|
||||
procedure printSpacedOperand(operand:integer);
|
||||
begin
|
||||
write(' ');
|
||||
printOperand(operand);
|
||||
end;
|
||||
|
||||
(* operates on numbers with less than 32 bits, signmask indicates the
|
||||
highest bit which is the sign *)
|
||||
function makepositive(operand, signmask:integer):integer;
|
||||
begin
|
||||
if (operand and signmask) <> 0 then
|
||||
makepositive := signmask - (operand and (not signmask))
|
||||
else
|
||||
makepositive := operand;
|
||||
end;
|
||||
|
||||
function signExtend(operand, signmask:integer):integer;
|
||||
begin
|
||||
if (operand and signmask) <> 0 then
|
||||
signExtend := -(signmask - (operand and (not signmask)))
|
||||
else
|
||||
signExtend := operand;
|
||||
end;
|
||||
|
||||
procedure printSignedOperand(operand, signmask:integer);
|
||||
var sym:HashRef;
|
||||
begin
|
||||
write(' ');
|
||||
sym := getHashed(symbolTable, operand);
|
||||
if sym <> nil then
|
||||
write(sym^.data)
|
||||
else
|
||||
begin
|
||||
if operand and signmask <> 0 then
|
||||
begin
|
||||
write('-');
|
||||
operand := makepositive(operand, signmask);
|
||||
end;
|
||||
printHex(operand);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure decodeBranch(operand:integer);
|
||||
begin
|
||||
write('BRANCH');
|
||||
printSpacedOperand(pc + signExtend(operand, $1000));
|
||||
end;
|
||||
|
||||
procedure decodeCbranch(operand:integer);
|
||||
begin
|
||||
write('CBRANCH');
|
||||
if (operand and 1) = 1 then
|
||||
write('.NZ')
|
||||
else
|
||||
write('.Z');
|
||||
|
||||
printSpacedOperand(pc + signExtend((operand and $FFFE), $100));
|
||||
end;
|
||||
|
||||
|
||||
procedure decodeLoadc(operand:integer);
|
||||
begin
|
||||
write('LOADC');
|
||||
printSignedOperand(operand, $1000);
|
||||
end;
|
||||
|
||||
procedure decodeLoadStore(name:string; operand:integer);
|
||||
begin
|
||||
write(name);
|
||||
if (operand and 1) = 1 then
|
||||
write('.B');
|
||||
|
||||
printSpacedOperand(operand and $FFFE);
|
||||
end;
|
||||
|
||||
procedure decodeModifier(name:string;value, mask:integer; operand:integer; visible:boolean);
|
||||
begin
|
||||
if (operand and mask) = value then
|
||||
if visible then
|
||||
write('.',name);
|
||||
end;
|
||||
|
||||
procedure decodeXfer(operand:integer);
|
||||
begin
|
||||
write('XFER');
|
||||
decodeModifier('RSM1', $0300, $0300, operand, true);
|
||||
decodeModifier('RS0', $0000, $0300, operand, false);
|
||||
decodeModifier('RS1', $0100, $0300, operand, true);
|
||||
decodeModifier('R2P', $0080, $0080, operand, true);
|
||||
decodeModifier('P2R', $0040, $0040, operand, true);
|
||||
decodeModifier('SM1', $0030, $0030, operand, true);
|
||||
decodeModifier('S0', $0000, $0030, operand, false);
|
||||
decodeModifier('S1', $0010, $0030, operand, true);
|
||||
decodeModifier('X2P', $0001, $0001, operand, true);
|
||||
end;
|
||||
|
||||
procedure printCmpOperand(operand:integer);
|
||||
begin
|
||||
case operand of
|
||||
2: write('EQ');
|
||||
6: write('NE');
|
||||
1: write('LT');
|
||||
3: write('LE');
|
||||
5: write('GE');
|
||||
7: write('GT');
|
||||
else write('<unknown:',operand,'>');
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure decodeAlu(operand:integer);
|
||||
var aluop:integer;
|
||||
begin
|
||||
write('ALU');
|
||||
decodeModifier('ADD', $0000, $1e00, operand, true);
|
||||
decodeModifier('SUB', $0200, $1e00, operand, true);
|
||||
decodeModifier('NOT', $0400, $1e00, operand, true);
|
||||
decodeModifier('AND', $0600, $1e00, operand, true);
|
||||
decodeModifier('OR', $0800, $1e00, operand, true);
|
||||
decodeModifier('XOR', $0a00, $1e00, operand, true);
|
||||
decodeModifier('CMP', $0c00, $1e00, operand, true);
|
||||
decodeModifier('Y', $0e00, $1e00, operand, true);
|
||||
decodeModifier('SHR', $1000, $1e00, operand, true);
|
||||
decodeModifier('SHL', $1200, $1e00, operand, true);
|
||||
decodeModifier('INC', $1400, $1e00, operand, true);
|
||||
decodeModifier('DEC', $1600, $1e00, operand, true);
|
||||
decodeModifier('BPLC', $1a00, $1e00, operand, true);
|
||||
decodeModifier('BROT', $1c00, $1e00, operand, true);
|
||||
decodeModifier('BSEL', $1e00, $1e00, operand, true);
|
||||
decodeModifier('CMPU', $1800, $1e00, operand, true);
|
||||
|
||||
decodeModifier('SM1', $0030, $0030, operand, true);
|
||||
decodeModifier('S0', $0000, $0030, operand, false);
|
||||
decodeModifier('S1', $0010, $0030, operand, true);
|
||||
decodeModifier('X2Y', $0040, $0040, operand, true);
|
||||
decodeModifier('NX2Y', $0000, $0040, operand, false);
|
||||
decodeModifier('XT', $0080, $0080, operand, true);
|
||||
|
||||
aluop := operand and $1e00;
|
||||
operand := operand and 15;
|
||||
|
||||
if (aluop = $1800) or (aluop = $0c00) then
|
||||
begin
|
||||
write(' ');
|
||||
printCmpOperand(operand);
|
||||
end
|
||||
else
|
||||
if operand > 0 then
|
||||
printSpacedOperand(operand);
|
||||
end;
|
||||
|
||||
procedure decodeLoadrel(offset:integer);
|
||||
begin
|
||||
write('LOADREL');
|
||||
printSpacedOperand(pc + offset);
|
||||
end;
|
||||
|
||||
procedure decodeMem(operand:integer);
|
||||
begin
|
||||
if (operand and $0200) <> 0 then
|
||||
begin
|
||||
write('STOREI');
|
||||
decodeModifier('SM1', $0030, $0030, operand, false);
|
||||
decodeModifier('S0', $0000, $0030, operand, true);
|
||||
decodeModifier('S1', $0010, $0030, operand, true);
|
||||
decodeModifier('X2Y', $0040, $0040, operand, true);
|
||||
decodeModifier('NX2Y', $0000, $0040, operand, false);
|
||||
decodeModifier('XT', $0080, $0080, operand, true);
|
||||
end
|
||||
else
|
||||
begin
|
||||
write('LOADI');
|
||||
decodeModifier('SM1', $0030, $0030, operand, true);
|
||||
decodeModifier('S0', $0000, $0030, operand, false);
|
||||
decodeModifier('S1', $0010, $0030, operand, true);
|
||||
decodeModifier('X2Y', $0040, $0040, operand, true);
|
||||
decodeModifier('NX2Y', $0000, $0040, operand, false);
|
||||
decodeModifier('XT', $0080, $0080, operand, true);
|
||||
end;
|
||||
operand := operand and 15;
|
||||
if operand > 0 then
|
||||
printSpacedOperand(operand);
|
||||
end;
|
||||
|
||||
procedure printRegOperand(operand:integer);
|
||||
begin
|
||||
case operand of
|
||||
0: write('FP');
|
||||
1: write('BP');
|
||||
2: write('RP');
|
||||
3: write('IV');
|
||||
4: write('IR');
|
||||
5: write('ESP');
|
||||
else write('<unknown:',operand,'>');
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure decodeReg(operand:integer);
|
||||
begin
|
||||
if (operand and $0200) <> 0 then
|
||||
write('STOREREG ')
|
||||
else
|
||||
write('LOADREG ');
|
||||
|
||||
operand := operand and 15;
|
||||
printRegOperand(operand);
|
||||
end;
|
||||
|
||||
procedure decodeExt(operand:integer);
|
||||
var extop:integer;
|
||||
begin
|
||||
extop := (operand and $1C00) shr 10;
|
||||
|
||||
if extop = 0 then
|
||||
decodeReg(operand)
|
||||
else
|
||||
if extop = 1 then
|
||||
decodeMem(operand)
|
||||
(*
|
||||
else
|
||||
if extop = 2 then
|
||||
begin
|
||||
{ unused }
|
||||
end *)
|
||||
else
|
||||
if extop = 3 then
|
||||
begin
|
||||
write('FPADJ ');
|
||||
printSignedOperand(operand and $03FF, $200);
|
||||
end
|
||||
else
|
||||
if extop = 5 then
|
||||
decodeLoadrel(operand and $03FF)
|
||||
else
|
||||
write('<EXT unknown:', extop,'>');
|
||||
end;
|
||||
|
||||
procedure decodeInstruction(w:integer);
|
||||
var baseIns:integer;
|
||||
baseOperand:integer;
|
||||
begin
|
||||
baseIns := (w and $E000) shr 13;
|
||||
baseOperand := (w and $1FFF);
|
||||
|
||||
(* writeln(baseIns, ' ', baseOperand); *)
|
||||
|
||||
if baseIns = 0 then
|
||||
decodeBranch(baseOperand)
|
||||
else
|
||||
if baseIns = 1 then
|
||||
decodeAlu(baseOperand)
|
||||
else
|
||||
if baseIns = 2 then
|
||||
decodeLoadStore('STORE', baseOperand)
|
||||
else
|
||||
if baseIns = 3 then
|
||||
decodeXfer(baseOperand)
|
||||
else
|
||||
if baseIns = 4 then
|
||||
decodeLoadStore('LOAD', baseOperand)
|
||||
else
|
||||
if baseIns = 5 then
|
||||
decodeCbranch(baseOperand)
|
||||
else
|
||||
if baseIns = 6 then
|
||||
decodeLoadc(baseOperand)
|
||||
else
|
||||
if baseIns = 7 then
|
||||
decodeExt(baseOperand)
|
||||
else
|
||||
write('???');
|
||||
|
||||
pc := pc + 2;
|
||||
|
||||
(* write(' (', baseIns, ')');
|
||||
writeHex(w); *)
|
||||
|
||||
printEol;
|
||||
end;
|
||||
|
||||
function isConstantPool(sym:HashRef):boolean;
|
||||
begin
|
||||
isConstantPool := false;
|
||||
|
||||
if sym <> nil then
|
||||
begin
|
||||
if length(sym^.data) >= 4 then
|
||||
isConstantPool :=
|
||||
(sym^.data[1] = '_') and
|
||||
(sym^.data[2] = 'C') and
|
||||
(sym^.data[3] = 'P') and
|
||||
(sym^.data[4] = '_');
|
||||
end;
|
||||
end;
|
||||
|
||||
function isStringConstant(sym:HashRef):boolean;
|
||||
begin
|
||||
isStringConstant := false;
|
||||
|
||||
if sym <> nil then
|
||||
begin
|
||||
if length(sym^.data) >= 5 then
|
||||
isStringConstant :=
|
||||
(sym^.data[1] = '_') and
|
||||
(sym^.data[2] = 'C') and
|
||||
(sym^.data[3] = '_') and
|
||||
(sym^.data[4] = 'S') and
|
||||
(sym^.data[5] = '_');
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure decodeIntConstant(upperHalf:integer);
|
||||
var lowerHalf:integer;
|
||||
w:integer;
|
||||
begin
|
||||
{$R-}
|
||||
pc := pc + 2;
|
||||
(* need to increment pc in two steps
|
||||
because readBin uses the pc to detect line endings
|
||||
(which is probably a bad idea *)
|
||||
|
||||
lowerHalf := readInstruction;
|
||||
w := (upperHalf shl 16) or lowerHalf;
|
||||
|
||||
pc := pc + 2;
|
||||
|
||||
write('.WORD ');
|
||||
printOperand(w);
|
||||
writeln;
|
||||
|
||||
{$R+}
|
||||
end;
|
||||
|
||||
procedure printPaddedLabel(sym:HashRef); forward;
|
||||
procedure printPc; forward;
|
||||
|
||||
procedure printLeadin;
|
||||
begin
|
||||
printPc;
|
||||
printPaddedLabel(nil);
|
||||
end;
|
||||
|
||||
procedure decodeString(upperHalf:integer);
|
||||
var lowerHalf:integer;
|
||||
curLength,maxLength:integer;
|
||||
i,wordCount:integer;
|
||||
w:integer;
|
||||
begin
|
||||
pc := pc + 2;
|
||||
lowerHalf := readInstruction;
|
||||
pc := pc + 2;
|
||||
curLength := (upperHalf shl 16) or lowerHalf;
|
||||
maxLength := readWord;
|
||||
|
||||
write('.WORD ');
|
||||
printHex(curLength);
|
||||
writeln;
|
||||
|
||||
printLeadin;
|
||||
write('.WORD ');
|
||||
printHex(maxLength);
|
||||
writeln;
|
||||
pc := pc + 4;
|
||||
|
||||
wordCount := curLength;
|
||||
if maxLength > curLength then
|
||||
wordCount := maxLength;
|
||||
|
||||
wordCount := (wordCount + 3) shr 2;
|
||||
|
||||
for i := 1 to wordCount do
|
||||
begin
|
||||
w := readWord;
|
||||
printLeadin;
|
||||
write('.BYTE ');
|
||||
printAsciiWord(w);
|
||||
writeln;
|
||||
pc := pc + 4;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure printPaddedLabel(sym:HashRef);
|
||||
var pad:integer;
|
||||
begin
|
||||
pad := 24;
|
||||
if sym <> nil then
|
||||
begin
|
||||
write(sym^.data);
|
||||
write(':');
|
||||
|
||||
pad := pad - length(sym^.data) - 1;
|
||||
end;
|
||||
|
||||
while pad > 0 do
|
||||
begin
|
||||
write(' ');
|
||||
pad := pad - 1;
|
||||
end;
|
||||
write(' ');
|
||||
end;
|
||||
|
||||
procedure printPc;
|
||||
var hexaddr:string[8];
|
||||
begin
|
||||
hexstr(pc, hexaddr);
|
||||
write(hexaddr, ' ');
|
||||
end;
|
||||
|
||||
procedure printLabels(adr:integer);
|
||||
var bucket:HashBucket;
|
||||
current:HashRef;
|
||||
first:boolean;
|
||||
begin
|
||||
(* there can be multiple labels
|
||||
at an instruction address,
|
||||
so go through all elements
|
||||
in the corresponding hash bucket *)
|
||||
first := true;
|
||||
bucket := getHashBucket(symbolTable, adr);
|
||||
current := bucket;
|
||||
while current <> nil do
|
||||
begin
|
||||
if current^.key = adr then
|
||||
begin
|
||||
if not first then
|
||||
begin
|
||||
writeln;
|
||||
(* printPc; *)
|
||||
write(' ');
|
||||
end
|
||||
else
|
||||
first := false;
|
||||
|
||||
printPaddedLabel(current);
|
||||
end;
|
||||
current := current^.next;
|
||||
end;
|
||||
|
||||
if first then
|
||||
printPaddedLabel(nil);
|
||||
end;
|
||||
|
||||
procedure decodeFile;
|
||||
var w:integer;
|
||||
sym:HashRef;
|
||||
begin
|
||||
while not eof(infile) do
|
||||
begin
|
||||
printPc;
|
||||
printLabels(pc);
|
||||
|
||||
w := readInstruction;
|
||||
|
||||
sym := getHashed(symbolTable, pc);
|
||||
if isConstantPool(sym) then
|
||||
decodeIntConstant(w)
|
||||
else
|
||||
if isStringConstant(sym) then
|
||||
decodeString(w)
|
||||
else
|
||||
decodeInstruction(w);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure testHash;
|
||||
var s:string;
|
||||
result:HashRef;
|
||||
i:integer;
|
||||
begin
|
||||
s := 'einszweidrei';
|
||||
putHashed(symbolTable, 123, s);
|
||||
s := 'vierfuenf';
|
||||
putHashed(symbolTable, 45, s);
|
||||
s := 'null';
|
||||
putHashed(symbolTable, 0, s);
|
||||
s := '0x7FFF1234';
|
||||
putHashed(symbolTable, $7FFF1234, s);
|
||||
|
||||
result := getHashed(symbolTable, 123);
|
||||
writeln('getHashed 123:', result^.data);
|
||||
|
||||
result := getHashed(symbolTable, 45);
|
||||
writeln('getHashed 45:', result^.data);
|
||||
|
||||
result := getHashed(symbolTable, 0);
|
||||
writeln('getHashed 0:', result^.data);
|
||||
|
||||
result := getHashed(symbolTable, $7FFF1234);
|
||||
writeln('getHashed $7FFF1234:', result^.data);
|
||||
|
||||
for i := 1 to 5000 do
|
||||
begin
|
||||
str(i,s);
|
||||
putHashed(symbolTable,i,s);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure readKeyword(var fil:InputFileType; var wordBuf:string);
|
||||
var c:char;
|
||||
skipWhite:boolean;
|
||||
done:boolean;
|
||||
begin
|
||||
wordBuf := '';
|
||||
done := false;
|
||||
skipWhite := true;
|
||||
|
||||
repeat
|
||||
read(fil,c);
|
||||
if c in [ ' ', #9, #13, #10, #0 ] then
|
||||
begin
|
||||
if not skipWhite then
|
||||
done := true;
|
||||
end
|
||||
else
|
||||
begin
|
||||
wordBuf := wordBuf + c;
|
||||
skipWhite := false;
|
||||
end;
|
||||
until done or eof(fil);
|
||||
if c = #13 then (* skip over CR/LF *)
|
||||
read(fil,c);
|
||||
end;
|
||||
|
||||
procedure readSymbolTable(var filename:string);
|
||||
var buf:string;
|
||||
fil:InputFileType;
|
||||
symStr:string;
|
||||
num:integer;
|
||||
begin
|
||||
openFile(fil, filename);
|
||||
while not eof(fil) do
|
||||
begin
|
||||
readKeyword(fil,buf);
|
||||
readKeyword(fil,symStr);
|
||||
num := convertHex(buf);
|
||||
putHashed(symbolTable, num, symStr);
|
||||
end;
|
||||
|
||||
close(fil);
|
||||
end;
|
||||
|
||||
function parseOrigin(s:string):integer;
|
||||
var i,c:integer;
|
||||
begin
|
||||
val(s,i,c);
|
||||
if c > 0 then
|
||||
errorExit2('invalid number',s);
|
||||
parseOrigin := i;
|
||||
end;
|
||||
|
||||
begin
|
||||
if paramCount < 1 then halt;
|
||||
|
||||
if paramCount >= 2 then
|
||||
begin
|
||||
filename := paramStr(2);
|
||||
readSymbolTable(filename);
|
||||
end;
|
||||
|
||||
if paramCount >= 3 then
|
||||
pc := parseOrigin(paramStr(3));
|
||||
|
||||
filename := paramStr(1);
|
||||
openFile(infile, filename);
|
||||
decodeFile;
|
||||
close(infile);
|
||||
|
||||
(* dumpHash(symbolTable); *)
|
||||
end.
|
||||
Loading…
Add table
Add a link
Reference in a new issue