Просмтор этого файла доступен только зарегистрированным пользователям. Но у нас супер быстрая регистрация: достаточно только электронной почты!

Текст из файла (страница 9)

WriteHexInt(N);

Write(':');

WriteHexInt(M)

end;

procedure HexString(var Str; N: INTEGER);

const

Hex: ARRAY [0 .. 15] OF CHAR = '0123456789ABCDEF';

var

i: byte;

begin

for i:= 0 to Mem[Seg(Str):Ofs(Str)] - 1 do

Mem[Seg(Str):(Ofs(Str)+Mem[Seg(Str):Ofs(Str)]-i)] :=

Ord(Hex[((N shr (i shl 2)) and $000F)])

end;

procedure WriteDouble(High, Low: INTEGER);

type

LongInt = ARRAY [0..3] OF BYTE;

const

Divisors : ARRAY [0..9] OF LongInt = ( ( 0, 0, 0, 1),

( 0, 0, 0, $A),

( 0, 0, 0, $64),

( 0, 0, 3, $E8),

( 0, 0, $27, $10),

( 0, 1, $86, $A0),

( 0, $F, $42, $40),

( 0, $98, $96, $80),

( 5, $F5, $E1, 0),

($3B, $9A, $CA, 0) );

var

i, j : INTEGER;

CharOffset,

Digit : BYTE;

Rep : ARRAY [0..9] OF CHAR;

Number : LongInt absolute Low;

OldNumber : LongInt;

stop : BOOLEAN;

begin

CharOffset := Ord(' ');

OldNumber := Number;

Rep := ' ';

for i:=9 downto 0 do begin

Digit := 0;

Number := OldNumber;

stop := false;

repeat

(* subtract Divisor from TestNumber *)

for j:=0 to 3 do begin

Number[j] := Number[j] - Divisors[i][3-j];

if (Number[j] > OldNumber[j]) AND (j<>3) then

Number[j+1] := number[j+1] - 1;

end;

if (Number[3] <= OldNumber[3]) then begin

Digit := succ(Digit);

CharOffset := Ord('0');

OldNumber := Number

end

else stop := true;

until stop;

Rep[9-i] := Chr(CharOffset+Digit);

end;

Write(Rep)

end;

procedure ComOut(var par);

const

WriteCommand = 1;

var

regs: RECORD

AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags: INTEGER

END;

B : BYTE absolute par;

begin

with Regs do begin

AX := (WriteCommand shl 8) + B;

DX := 0;

Intr($14, Regs);

end

end;

procedure BlockRead (var f: file; var buffer; var n: integer);

const

readfunction = $3F;

var

regs: RECORD

AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags: INTEGER

END;

begin

with Regs do begin

AX := (readfunction shl 8);

BX := MemW[Seg(f):Ofs(f)];

CX := n;

DX := Ofs(buffer);

DS := Seg(buffer);

Intr($21, Regs);

if (Flags and $0001) = 1 then begin

write('I/O Error ');

writeHex(AX shr 8);

writeln (' during BlockRead');

end

else

n := AX

end;

end;

function FileSize (var f: file): INTEGER;

const

seekfunction = $42;

from_begin = 0;

from_current = 1;

from_end = 2;

var

regs: RECORD

AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags: INTEGER

END;

CurrentFilePointer_low,

CurrentFilePointer_high : INTEGER;

begin

with Regs do begin

AX := (seekfunction shl 8) + from_current;

BX := MemW[Seg(f):Ofs(f)]; (* handle ! *)

CX := 0; (* offset-high *)

DX := 0; (* offset-low *)

Intr($21, Regs);

if (Flags and $0001) = 1 then begin

write('I/O Error ');

writeHex(AX shr 8);

writeln (' during FileSize');

end;

CurrentFilePointer_low := AX;

CurrentFilePointer_high := DX;

(* determine file size *)

AX := (seekfunction shl 8) + from_end;

BX := MemW[Seg(f):Ofs(f)]; (* handle ! *)

CX := 0; (* offset-high *)

DX := 0; (* offset-low *)

Intr($21, Regs);

if (Flags and $0001) = 1 then begin

write('I/O Error ');

writeHex(AX shr 8);

writeln (' during FileSize');

end;

FileSize := AX;

(* restore FilePointer *)

AX := (seekfunction shl 8) + from_begin;

BX := MemW[Seg(f):Ofs(f)]; (* handle ! *)

CX := CurrentFilePointer_high;

DX := CurrentFilePointer_low;

Intr($21, Regs);

if (Flags and $0001) = 1 then begin

write('I/O Error ');

writeHex(AX shr 8);

writeln (' during FileSize');

end;

end

end;

procedure BlockWrite (var f: file; var b; var n: integer);

const

writefunction = $40;

var

regs: RECORD

AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags: INTEGER

END;

begin

with Regs do begin

AX := (writefunction shl 8);

BX := MemW[Seg(f):Ofs(f)];

CX := n;

DX := Ofs(b);

DS := Seg(b);

Intr($21, Regs);

if (Flags and $0001) = 1 then begin

write('I/O Error ');

writeHex(AX shr 8);

writeln (' during BlockWrite');

end

end;

end;

procedure Open(var f: file; VAR Name);

const

OpenFunction = $3D;

OpenMode = 128; (* read only *)

var

FName: STRING [255] ABSOLUTE Name;

regs: RECORD

AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags: INTEGER

END;

begin

FName := FName + chr (0);

with Regs do begin

AX := (OpenFunction shl 8) + OpenMode;

DX := Ofs (FName) + 1;

DS := Seg (FName);

Intr($21, Regs);

MemW [Seg (f) : Ofs (f)] := AX;

if (Flags and $0001) = 1 then begin

write('I/O Error ');

writeHex(AX shr 8);

writeln (' during Reset');

end

end

end;

----------- start of source ---- CUT HERE FOR DEB2ASM.PAS -------------

const

blank = ' ';

tab = #9;

comma = ',';

colon = ':';

semicolon = ';';

type

STR4 = STRING[4];

STR5 = STRING[5];

STR6 = STRING[6];

STR12 = STRING[12];

STR18 = STRING[18];

STR80 = STRING[80];

ReferenceTypes = (None, B, W, D, N, F);

ParseTypes = RECORD

Offset : STR4;

HexCode : STR12;

OpCode : STR6;

Operand1,

Operand2 : STR12;

Comment : BYTE; (* position where comment starts *)

TypeOverride : ReferenceTypes

END;

var

f_in, f_out : text[$2000];

Line : STR80;

LineCount,

CharPos : INTEGER;

FileName : STR80;

FileExt : BOOLEAN;

Rep : ARRAY [ReferenceTypes] OF STR5;

ParsedLine : ParseTypes;

(*$I \io.inc *)

(*$I \sort.box *)

const

SymbolTableSize = 2000;

type

TableEntry = RECORD

offset,

reference : INTEGER;

reftype : ReferenceTypes;

position : BYTE

END;

var

SymbolTable,

AuxTable : ARRAY [0 .. SymbolTableSize] OF TableEntry;

Current_SymbolTable_Index,

Symbol_Table_Length,

SortInputIndex,

SortOutputIndex,

SortStatus : INTEGER;

(* TOOLBOX SORT interface *)

procedure Inp;

begin

while SortInputIndex < Symbol_Table_Length do begin

SortRelease(SymbolTable[SortInputIndex]);

SortInputIndex := succ(SortInputIndex)

end;

end;

procedure Outp;

begin

while (NOT SortEOS) AND (SortOutputIndex <= Symbol_Table_Length) do begin

SortReturn(AuxTable[SortOutputIndex]);

SortOutputIndex := succ(SortOutputIndex) ;

end;

end;

function Less;

var

Entry1 : TableEntry absolute X;

Entry2 : TableEntry absolute Y;

begin

if Entry1.reference = Entry2.reference then

Less := Ord(Entry1.reftype) < Ord(Entry2.reftype)

else (* compare the Entries as unsigned integers *)

if ((Entry1.reference XOR Entry2.reference) AND $8000) = 0 then

Less := Entry1.reference < Entry2.reference

else if (Entry1.reference AND $8000)= $8000 then Less := false

else Less := true;

end;

procedure StoreReference(_Offset, _Label: INTEGER; _RefType: ReferenceTypes;

_position: BYTE);

(* This procedure keeps a table of locations referenced *)

(* including the type of reference *)

begin

(* if _RefType = N then begin

write('label at ');

writeHexInt(_Offset); write(' value: ');

writeHexInt(_Label);

end else begin

write('var ref at ');

writeHexInt(_Offset); write(' to location ');

writehexint(_Label);

write(' type: ', rep[_RefType]);

end;

*)

with SymbolTable[Current_SymbolTable_Index] do begin

offset := _Offset;

reference := _Label;

reftype := _RefType;

position := _position

end;

Current_SymbolTable_Index := succ(Current_SymbolTable_Index);

if Current_SymbolTable_Index = SymbolTableSize then begin

writeln(' SymbolTable overflow ..., program halted');

halt

end;

end;

procedure ParseLine(var Result: ParseTypes);

(* Parses one line of disassembly output *)

label

EndParseLine;

type

CharSet = SET OF CHAR;

const

U : CharSet = [#0 .. #$FF];

var

j, k : INTEGER;

procedure SkipBT; (* Skip blanks and tabs *)

label

EndSkip;

begin

while CharPos <= Ord(Line[0]) do begin

case Line[CharPos] of

blank: CharPos := succ(CharPos);

tab: CharPos := succ(CharPos)

else goto EndSkip

end

end;

EndSkip: end;

procedure SkipBTC; (* Skip blanks, tabs and commas *)

label

EndSkip;

begin

while CharPos <= Ord(Line[0]) do begin

case Line[CharPos] of

blank: CharPos:=succ(CharPos);

comma: CharPos:=succ(CharPos);

tab: CharPos:=succ(CharPos)

else goto EndSkip

end

end;

EndSkip: end;

procedure SkipUBT;

label

EndSkip;

begin

(* Structered code was: *)

(* *)

(* while (Line[CharPos] IN U-[blank,tab,semicolon]) do *)

(* CharPos:=succ(CharPos) *)

(* while ( (Line[CharPos] <> blank) AND (Line[CharPos] <> tab) *)

(* AND (Line[CharPos] <> semicolon) ) *)

(* AND (CharPos <= Length(Line)) do CharPos:= succ(CharPos); *)

while CharPos <= Ord(Line[0]) do begin

case Line[CharPos] of

blank: goto EndSkip;

tab: goto EndSkip;

semicolon: goto EndSkip

else CharPos := succ(CharPos)

end

end;

EndSkip: end;

procedure SkipUBTC;

label

EndSkip;

begin

(* !! Structered code was: *)

(* *)

(* while ( (Line[CharPos] <> blank) *)

(* AND (Line[CharPos] <> tab) *)

(* AND (Line[CharPos] <> comma) *)

(* AND (Line[CharPos] <> semicolon) *)

(* AND (CharPos <= Length(Line) ) do *)

(* CharPos:= succ(CharPos); *)

while CharPos <= Ord(Line[0]) do begin

case Line[CharPos] of

blank: goto EndSkip;

comma: goto EndSkip;

tab: goto EndSkip;

semicolon: goto EndSkip

else CharPos := succ(CharPos)

end

end;

EndSkip: end;

function Stop: BOOLEAN;

begin

(* code was: Stop := (Line[CharPos]=semicolon) *)

(* OR (CharPos > Length(Line) ) *)

(* remark: this function should perhaps be inline *)

if CharPos > Ord(Line[0]) then Stop := true

else if Line[CharPos] = semicolon then begin

Stop := true;

Result.Comment := CharPos

end

else Stop := false

end;

function Appropriate: BOOLEAN;

(* Find out whether the current line should be parsed *)

var

k: INTEGER;

begin

CharPos := 1;

if (Length(Line)<5) OR (Line[1]='-') then Appropriate := false

else begin

k := 1;

while NOT (Line[k] IN [colon, semicolon]) AND (k<6) do k:= succ(k);

if Line[k] <> semicolon then begin

Appropriate := true;

if Line[k] = colon then begin

CharPos := k + 1;

end

end else begin

Appropriate := false;

Result.Comment := k

end

end

end;

begin (* ParseLine *)

with Result do begin

TypeOverride := None;

Offset[0] := Chr(0);

HexCode[0] := Chr(0);

OpCode[0] := Chr(0);

Operand1[0] := Chr(0);

Operand2[0] := Chr(0);

Comment := Ord(Line[0]) + 1;

if NOT Appropriate then goto EndParseLine;

SkipBT; if Stop then goto EndParseLine;

k := CharPos;

SkipUBT;

(* Offset := Copy(Line, k, CharPos-k); *)

Offset[0] := Chr(CharPos-k);

Move(Line[k], Offset[1], CharPos-k);

SkipBT; if Stop then goto EndParseLine;

k := CharPos;

SkipUBT;

(* HexCode := Copy(Line, k, CharPos-k); *)

HexCode[0] := Chr(CharPos-k);

Move(Line[k], HexCode[1], CharPos-k);

SkipBT; if Stop then goto EndParseLine;

k := CharPos;

SkipUBT;

(* OpCode := Copy(Line, k, CharPos-k); *)

OpCode[0] := Chr(CharPos-k);

Move(Line[k], OpCode[1], CharPos-k);

SkipBT; if Stop then goto EndParseLine;

(* at first operand *)

k := CharPos;

SkipUBTC;

(* Operand1 := Copy(Line, k, CharPos-k); *)

Operand1[0] := Chr(CharPos-k);

Move(Line[k], Operand1[1], CharPos-k);

case Operand1[1] of

'B': if Operand1 = 'BYTE' then begin

TypeOverride := B;

SkipBT; if Stop then goto EndParseLine;

SkipUBT;

SkipBT; if Stop then goto EndParseLine;

k := CharPos;

SkipUBTC;

(* Operand1 := Copy(Line, k, CharPos-k); *)

Operand1[0] := Chr(CharPos-k);

Move(Line[k], Operand1[1], CharPos-k);

end;

'W': if Operand1 = 'WORD' then begin

TypeOverride := W;

SkipBT; if Stop then goto EndParseLine;

SkipUBT;

SkipBT; if Stop then goto EndParseLine;

k := CharPos;

SkipUBTC;

(* Operand1 := Copy(Line, k, CharPos-k); *)

Operand1[0] := Chr(CharPos-k);

Move(Line[k], Operand1[1], CharPos-k);

end;

'D': if Operand1 = 'DWORD' then begin

TypeOverride := D;

SkipBT; if Stop then goto EndParseLine;

SkipUBT;

SkipBT; if Stop then goto EndParseLine;

k := CharPos;

SkipUBTC;

(* Operand1 := Copy(Line, k, CharPos-k); *)

Operand1[0] := Chr(CharPos-k);

Move(Line[k], Operand1[1], CharPos-k);

end;

'F': if Operand1 = 'FAR' then begin

TypeOverride := F;

SkipBT; if Stop then goto EndParseLine;

k := CharPos;

SkipUBTC;

(* Operand1 := Copy(Line, k, CharPos-k); *)

Operand1[0] := Chr(CharPos-k);

Move(Line[k], Operand1[1], CharPos-k);

end;

end;

SkipBTC; if Stop then goto EndParseLine;

(* second operand *)

k := CharPos;

SkipUBTC;

(* Operand2 := Copy(Line, k, CharPos-k); *)

Operand2[0] := Chr(CharPos-k);

Move(Line[k], Operand2[1], CharPos-k);

(* check for type override operators *)

case Operand2[1] of

'B': if Operand2 = 'BYTE' then begin

TypeOverride := B;

SkipBT; if Stop then goto EndParseLine;

SkipUBT;

SkipBT; if Stop then goto EndParseLine;

k := CharPos;

SkipUBTC;

(* Operand2 := Copy(Line, k, CharPos-k); *)

Operand2[0] := Chr(CharPos-k);

Move(Line[k], Operand2[1], CharPos-k);

end;

'W': if Operand2 = 'WORD' then begin

TypeOverride := W;

SkipBT; if Stop then goto EndParseLine;

SkipUBT;

SkipBT; if Stop then goto EndParseLine;

k := CharPos;

SkipUBTC;

(* Operand2 := Copy(Line, k, CharPos-k); *)

Operand2[0] := Chr(CharPos-k);

Move(Line[k], Operand2[1], CharPos-k);

end;

'D': if Operand2 = 'DWORD' then begin

TypeOverride := D;

SkipBT; if Stop then goto EndParseLine;

SkipUBT;

SkipBT; if Stop then goto EndParseLine;

k := CharPos;

SkipUBTC;

(* Operand2 := Copy(Line, k, CharPos-k); *)

Operand2[0] := Chr(CharPos-k);

Move(Line[k], Operand2[1], CharPos-k);

end;

'F': if Operand2 = 'FAR' then begin

TypeOverride := F;

SkipBT; if Stop then goto EndParseLine;

k := CharPos;

SkipUBTC;

(* Operand2 := Copy(Line, k, CharPos-k); *)

Operand2[0] := Chr(CharPos-k);

Move(Line[k], Operand2[1], CharPos-k);

end

end

end;

EndParseLine: end;

procedure Pass1;

var

_Offset,

_Label, _Mem,

Status : INTEGER;

function OperandType(var Operand: STR12): ReferenceTypes;

begin

case Operand[2] of

'X': case Operand[1] of

'A': OperandType := W;

'B': OperandType := W;

'C': OperandType := W;

'D': OperandType := W

end;

'S': case Operand[1] of

'C': OperandType := W;

'D': OperandType := W;

'E': OperandType := W;

'S': OperandType := W

end;

'L': case Operand[1] of

'A': OperandType := B;

'B': OperandType := B;

'C': OperandType := B;

'D': OperandType := B

end;

'H': case Operand[1] of

'A': OperandType := B;

'B': OperandType := B;

'C': OperandType := B;

'D': OperandType := B

end;

'I': case Operand[1] of

'S': OperandType := W;

'D': OperandType := W

end;

'P': case Operand[1] of

'B': OperandType := W;

'S': OperandType := W

end

end (* case *)

end;

procedure MemoryOperand(var Operand, OperandX: STR12; Position: BYTE;

ExplicitType: ReferenceTypes);

begin

if (Ord(Operand[0])=6) then begin

if (Operand[1] = '[') AND (Operand[6] = ']') then begin

Val ( '$'+Copy(Operand, 2, 4), _Mem, Status);

if Status = 0 then begin (* valid 4 digit hex number *)

case ExplicitType of

N: ExplicitType := W; (* indirect jump or call *)

F: ExplicitType := D (* far indirect jump or call *)

end;

if (ExplicitType <> None) then

StoreReference (_Offset, _Mem, ExplicitType, Position)

else

StoreReference (_Offset, _Mem, OperandType(OperandX), Position);

end (* valid memory operand *)

end (* [,] *)

end (* length = 6 *)

end;

begin (* Pass 1 *)

gotoXY(1,25); Write('Pass 1 , Line ');

LineCount := 0;

while NOT EOF(f_in) do begin

readln(f_in, Line);

LineCount := succ(LineCount);

if (LineCount and $000F) = 0 then begin

gotoXY(16,25);

write(LineCount:3)

end;

ParseLine(ParsedLine);

with ParsedLine do begin

(****

gotoxy(12,wherey);writeln(offset,'|','|',opcode,'|',

operand1,'|',operand2,'|');

****)

Val ( '$'+Offset, _Offset, Status);

if Status = 0 then begin

Status := -1;

(* check for opcodes with CODE_LABEL operands *)

case OpCode[1] of

'J': begin

Val ( '$'+Operand1, _Label, Status);

if Status <> 0 then begin

if (OpCode = 'JMP') AND (TypeOverride=None) then

TypeOverride := N; (* try indirect NEAR jump *)

end

end;

'C': if OpCode = 'CALL' then begin

Val ( '$'+Operand1, _Label, Status);

if (Status <> 0) AND (Operand1[5]=':') then begin

Val('$'+Copy(Operand1, 6, 4), _Label, Status);

if Status = 0 then StoreReference (_Offset, _Label, F, 1);

Status := -1;

end

end;

'L': if (OpCode = 'LOOP') OR

(OpCode = 'LOOPZ') OR (OpCode = 'LOOPNZ')

then Val ( '$'+Operand1, _Label, Status);

'P': if OpCode = 'PUSH' then TypeOverride := W

else if OpCode = 'POP' then TypeOverride := W;

end (* case *);

if Status = 0 then begin (* valid near label *)

StoreReference (_Offset, _Label, N, 1)

end;

MemoryOperand(Operand1, Operand2, 1, TypeOverride);

MemoryOperand(Operand2, Operand1, 2, TypeOverride);

end (* valid offset *)

end (* with ParsedLine *)

end (* while *);

gotoXY(16,25); write(LineCount:3);

end (* Pass 1 *);

procedure Pass2;

type

PrefixTypes = (NoPrefix, REP, REPZ, REPNZ, LOCK, CS, DS, ES, SS);

var

k, _Offset,

NextOffset,

NextRef,

Status : INTEGER;

Prefix : PrefixTypes;

ASMLine : STR80;

function TestPrefix: BOOLEAN;

var

HexByte, Status: INTEGER;

begin

case ParsedLine.OpCode[3] of (* test for prefix opcodes *)

':', 'P', 'C' : begin

Val('$'+ParsedLine.HexCode, HexByte, Status);

case HexByte of

$2E: begin Prefix := CS; TestPrefix := true end;

$26: begin Prefix := ES; TestPrefix := true end;

$3E: begin Prefix := DS; TestPrefix := true end;

$36: begin Prefix := SS; TestPrefix := true end;

$F2: begin Prefix := REPNZ; TestPrefix := true end;

$F3: begin Prefix := REPZ; TestPrefix := true end;

$F0: begin Prefix := LOCK; TestPrefix := true end;

else TestPrefix := false

end

end

else TestPrefix := false

end;

end;

begin (* Pass 2 *)

gotoXY(1,25); Write('Pass 2 , Line ');

NextOffset := 0;

NextRef := 0;

Prefix := NoPrefix;

LineCount := 0;

while NOT EOF(f_in) do begin

readln(f_in, Line);

LineCount := succ(LineCount);

if (LineCount and $000F) = 0 then begin

gotoXY(16,25);

write(LineCount:3)

end;

ParseLine(ParsedLine);

if NOT TestPrefix then begin

with ParsedLine do begin

if (Prefix = REPZ) OR (Prefix = REPNZ) then begin

if (Opcode[1] IN ['M', 'L', 'S']) AND (Ord(OpCode[0])<>0) then

Prefix := REP

end;

Val ( '$'+Offset, _Offset, Status);

if Status = 0 then begin

if _Offset = SymbolTable[NextOffset].offset then begin

case SymbolTable[NextOffset].reftype of

N: begin

Move(Operand1[1], Operand1[3], 4);

Operand1[0] := succ(succ(Operand1[0]));

Operand1[1] := 'L';

Operand1[2] := '_';

end;

B,W,D: begin

if SymbolTable[NextOffset].position = 1 then begin

Operand1[1] := 'V';

Operand1[6] := '_';

end else begin

Operand2[1] := 'V';

Operand2[6] := '_';

end

end;

end;

NextOffset := succ(NextOffset);

end;

while AuxTable[NextRef].reference < _Offset do

NextRef := succ(NextRef);

while _Offset = AuxTable[NextRef].reference do begin

case AuxTable[NextRef].reftype of

N: begin

Writeln(f_out, ' L_'+ Offset+':');

end;

B: begin

Writeln(f_out, ' V_'+ Offset+tab+'DB', tab, '?');

end;

W: begin

Writeln(f_out, ' V_'+ Offset+tab+'DW', tab, '?');

end;

D: begin

Writeln(f_out, ' V_'+ Offset+tab+'DD', tab, '?');

end;

end;

repeat NextRef:=succ(NextRef)

until (AuxTable[NextRef].reftype <> AuxTable[NextRef-1].reftype) OR

(_Offset <> AuxTable[NextRef].reference) OR

(NextRef >= Symbol_Table_Length);

end;

if Offset[0] <> Chr(0) then begin

write(f_out, tab, tab);

case Prefix of

REP: begin

write(f_out, 'REP ');

Prefix := NoPrefix

end;

REPZ: begin

write(f_out, 'REPZ ');

Prefix := NoPrefix

end;

REPNZ:begin

write(f_out, 'REPNZ ');

Prefix := NoPrefix

end;

LOCK: begin

write(f_out, 'LOCK ');

Prefix := NoPrefix

end;

end;

write(f_out, OpCode, tab);

if Ord(Operand1[0]) > 2 then begin

case TypeOverride of

None: ;

B : write(f_out, 'BYTE PTR ');

W : write(f_out, 'WORD PTR ');

D : write(f_out, 'DWORD PTR ');

F : write(f_out, 'FAR PTR ');

end;

case Prefix of

NoPrefix: ;

CS: begin write(f_out, 'CS:'); Prefix := NoPrefix end;

ES: begin write(f_out, 'ES:'); Prefix := NoPrefix end;

SS: begin write(f_out, 'SS:'); Prefix := NoPrefix end;

DS: begin write(f_out, 'DS:'); Prefix := NoPrefix end;

end;

end;

write(f_out, Operand1);

if Operand2[0]<>Chr(0) then begin

write(f_out, ', ');

if Ord(Operand2[0]) > 2 then begin

case TypeOverride of

None: ;

B : write(f_out, 'BYTE PTR ');

W : write(f_out, 'WORD PTR ');

D : write(f_out, 'DWORD PTR ');

F : write(f_out, 'FAR PTR ');

end;

case Prefix of

NoPrefix: ;

CS: begin write(f_out, 'CS:'); Prefix := NoPrefix end;

ES: begin write(f_out, 'ES:'); Prefix := NoPrefix end;

SS: begin write(f_out, 'SS:'); Prefix := NoPrefix end;

DS: begin write(f_out, 'DS:'); Prefix := NoPrefix end;

end;

end;

write(f_out, Operand2);

end

else write(f_out, tab);

end;

if Comment <= Ord(Line[0]) then

writeln(f_out, tab, Copy(Line, comment, Ord(Line[0])+1-comment))

else

writeln(f_out)

end (* valid offset *)

end (* with *)

end

end;

gotoXY(16,25); write(LineCount:3);

end (* Pass2 *);

procedure CrossRefList;

var

OffsetStr, RefStr: STR4;

k: INTEGER;

begin

writeln(f_out, ' ******* writing cross reference listing ******');

writeln(f_out);

CharPos:= 0;

while CharPos<= (symbol_table_length-1) do begin

with AuxTable[CharPos] do begin

OffsetStr[0] := Chr(4); RefStr[0] := Chr(4);

HexString(OffsetStr, reference);

HexString(RefStr, offset);

case reftype of

(* N: Write(f_out, 'L_', OffsetStr, 'N', tab, 'LABEL', tab, 'NEAR',

' ; R_', RefStr);

*)

B: Write(f_out, 'V_', OffsetStr, 'B', ' ', 'LABEL', tab, 'BYTE',

tab, '; R_', RefStr);

W: Write(f_out, 'V_', OffsetStr, 'W', ' ', 'LABEL', tab, 'WORD',

tab, '; R_', RefStr);

D: Write(f_out, 'V_', OffsetStr, 'D', ' ', 'LABEL', tab, 'DWORD',

tab, '; R_', RefStr);

F: Write(f_out, 'L_', OffsetStr, 'F', ' ', 'LABEL', tab, 'FAR',

tab, '; R_', RefStr);

end;

(*

writehexint(reference);write(' ');

writehexint(offset);write(' ');

write(rep[reftype]);write(' ');

writeln(position:2);

*)

CharPos:=succ(CharPos);

k := 1;

while (reftype = AuxTable[CharPos].reftype) AND

(reference = AuxTable[CharPos].reference) AND

(CharPos<= Symbol_Table_Length - 1)

do begin

if reftype <> N then begin

HexString(RefStr, AuxTable[CharPos].offset);

if k = 5 then begin

k:=0;

writeln(f_out);

write(f_out, tab,tab,tab,tab, '; R_', RefStr) end

else write(f_out, ' ,R_', RefStr);

k := succ(k)

end;

CharPos:= succ(CharPos)

end;

if reftype <> N then writeln(f_out);

end;

end;

writeln(f_out);

end;

begin

rep[none]:='NONE';

rep[B]:='BYTE';rep[W]:='WORD';rep[D]:='DWORD';

rep[N]:='NEAR';rep[F]:='FAR';

Current_SymbolTable_Index:= 0;

write('Enter filename: '); readln(FileName);

FileExt := false;

for CharPos:=1 to Length(FileName) do FileExt := FileName[CharPos] = '.';

if FileExt then assign(f_in, FileName)

else assign(f_in, FileName+'.DEB');

(* start pass 1 *)

reset(f_in);

Pass1;

Symbol_Table_Length := Current_SymbolTable_Index;

Current_SymbolTable_Index := 0;

Writeln;

Writeln(Symbol_Table_Length, ' symbols');

(* Sort symboltable *)

SortInputIndex := 0;

SortOutputIndex := 0;

Writeln('Sorting symboltable ...');

SortStatus := TurboSort(SizeOf(TableEntry));

if SortStatus <> 0 then writeln('Error ', SortStatus:2, ' during sorting');

if FileExt then begin

CharPos:= 1;

while FileName[CharPos] <> '.' do CharPos:= succ(CharPos);

FileName := copy(FileName, 1, pred(CharPos));

end;

assign(f_out, FileName+'.DBO');

rewrite(f_out);

Writeln('Writing cross-reference');

CrossRefList;

(* start pass 2 *)

reset(f_in);

Pass2;

close(f_out);

close(f_in)

end.

-------------------- end --------------

Литература.

1. Питер Абель «АССЕМБЛЕР И ПРОГРАММИРОВАНИЕ ДЛЯ IBM PC». Технологический институт Британская Колумбия.

2. В.И.Юров «Assembler (практикум и пособие)». Изд. Питер.

Москва.2002.

3. А.А. Абдукодиров «IBM PC АССЕМБЛЕРИДА ПРОГРАММАЛАШ

АСОСЛАРИ» Университет 1998.

4. Р.Браун. «Справочник по прерываниям IBM PC» Москва,

издательство "Мир", 1994.

5. Р.Джордейн «Справочник программиста персональных компьютеров

типа IBM PC, XT и AT». Москва, "Фин. и статистика" 1992.

1. И.В.Юров «Справочная система по языку ассемблера IBM PC». СПВУРЭ ПВО. 2000.

1. Интернет сайты:

www.ilf.net

home1.gte.net/rdhaar/hotbox/

www.agate.net/~krees/

www.cdc.net/~x/

www.chibacity.com/chiba/

www.conexis.es/~amasso/

www.virewall.narod.ru/vir.html

www.etu.net.ru

www.ruler.h1.ru/asm/abel/

www.google.com/search/asm

www.hangup.da.ru/

www.home.pages.at/rolik/

www.bib.ru

Характеристики

Список файлов реферата