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 --------------

Литература

exe файл программа

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

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

Москва.2002.

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

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

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

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

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

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

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

Размещено на Allbest.ru

...