home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Turbo Toolbox
/
Turbo_Toolbox.iso
/
1990
/
11
/
trash
/
keytrash.pas
next >
Wrap
Pascal/Delphi Source File
|
1989-09-27
|
34KB
|
660 lines
Program Trash_mit_Tastatureingabe;
{$M 4096,0,0}
{$V-}
USES DOS,CRT;
{-----------------------------------------------------------------------------}
Procedure Assemble;
Type SetType = 0..24;
ByteWordType = (NoLen,BLen,WLen);
BefehlType = (MOV,PUSH,POP,XCHG,IN_,OUT,XLAT,LEA,LDS,LES,LAHF,SAHF,PUSHF,
POPF,ADD,ADC,INC_,AAA,DAA,SUB,SBB,DEC_,NEG,CMP,AAS,DAS,MUL,
IMUL,AAM,DIV_,IDIV,AAD,CBW,CWD,NOT_,SHL_,SAL,SHR_,SAR,ROL,ROR,
RCL,RCR,AND_,TEST,OR_,XOR_,REP,REPZ,REPE,REPNE,REPNZ,MOVSB,CMPSB,
SCASB,LODSB,STOSB,CALL,JMP,RET,JE,JZ,JL,JNGE,JLE,JNG,JB,JNAE,JP,JPE,JO,
JS,JNE,JNZ,JNL,JGE,JNLE,JG,JNB,JAE,JNBE,JA,JNP,JPO,JNO,JNS,JNA,JBE,
LOOP,LOOPZ,LOOPE,LOOPNZ,LOOPNE,JCXZ,INT,INTO,IRET,CLC,STC,
CMC,CLD,CLI,HLT,LOCK,NOP,STD,STI,WAIT,MOVSW,CMPSW,SCASW,
LODSW,STOSW,CALLF,RETF,JMPF,CS,SS,DS,ES,NOBEF);
const BefBez : Array[BefehlType] of String[6] =
('MOV','PUSH','POP','XCHG','IN','OUT','XLAT','LEA','LDS','LES','LAHF','SAHF','PUSHF',
'POPF','ADD','ADC','INC','AAA','DAA','SUB','SBB','DEC','NEG','CMP','AAS','DAS','MUL',
'IMUL','AAM','DIV','IDIV','AAD','CBW','CWD','NOT','SHL','SAL','SHR','SAR','ROL','ROR',
'RCL','RCR','AND','TEST','OR','XOR','REP','REPZ','REPE','REPNE','REPNZ','MOVSB','CMPSB','SCASB',
'LODSB','STOSB','CALL','JMP','RET','JE','JZ','JL','JNGE','JLE','JNG','JB','JNAE','JP','JPE','JO',
'JS','JNE','JNZ','JNL','JGE','JNLE','JG','JNB','JAE','JNBE','JA','JNP','JPO','JNO','JNS','JNA',
'JBE','LOOP','LOOPZ','LOOPE','LOOPNZ','LOOPNE','JCXZ','INT','INTO','IRET','CLC','STC',
'CMC','CLD','CLI','HLT','LOCK','NOP','STD','STI','WAIT','MOVSW','CMPSW','SCASW',
'LODSW','STOSW','CALLF','RETF','JMPF','CS:','SS:','DS:','ES:','NOBEF');
BefAnz = 178;
BefBytes : Array[0..BefAnz] of record
Befehl : BefehlType;
AddType : SetType;
first,next : Byte;
end =
((Befehl : MOV; AddType : 15; first : $A0; next : $00),
(Befehl : MOV; AddType : 16; first : $A2; next : $00),
(Befehl : MOV; AddType : 13; first : $B0; next : $00),
(Befehl : MOV; AddType : 9; first : $88; next : $00),
(Befehl : MOV; AddType : 10; first : $8A; next : $00),
(Befehl : MOV; AddType : 11; first : $8C; next : $00),
(Befehl : MOV; AddType : 12; first : $8E; next : $00),
(Befehl : MOV; AddType : 14; first : $C6; next : $00),
(Befehl : PUSH; AddType : 03; first : $50; next : $00),
(Befehl : PUSH; AddType : 04; first : $06; next : $00),
(Befehl : PUSH; AddType : 05; first : $FF; next : $30),
(Befehl : POP; AddType : 03; first : $58; next : $00),
(Befehl : POP; AddType : 04; first : $07; next : $00),
(Befehl : POP; AddType : 05; first : $8F; next : $00),
(Befehl : XCHG; AddType : 17; first : $90; next : $00),
(Befehl : XCHG; AddType : 09; first : $86; next : $00),
(Befehl : XCHG; AddType : 10; first : $86; next : $00),
(Befehl : IN_; AddType : 18; first : $E4; next : $00),
(Befehl : IN_; AddType : 19; first : $EC; next : $00),
(Befehl : OUT; AddType : 18; first : $E6; next : $00),
(Befehl : OUT; AddType : 19; first : $EE; next : $00),
(Befehl : XLAT; AddType : 00; first : $D7; next : $00),
(Befehl : LEA; AddType : 10; first : $8D; next : $00),
(Befehl : LDS; AddType : 10; first : $C5; next : $00),
(Befehl : LES; AddType : 10; first : $C4; next : $00),
(Befehl : LAHF; AddType : 00; first : $9F; next : $00),
(Befehl : SAHF; AddType : 00; first : $9E; next : $00),
(Befehl : PUSHF; AddType : 00; first : $9C; next : $00),
(Befehl : POPF; AddType : 00; first : $9D; next : $00),
(Befehl : ADD; AddType : 21; first : $04; next : $00),
(Befehl : ADD; AddType : 09; first : $00; next : $00),
(Befehl : ADD; AddType : 10; first : $02; next : $00),
(Befehl : ADD; AddType : 20; first : $80; next : $00),
(Befehl : ADC; AddType : 21; first : $14; next : $00),
(Befehl : ADC; AddType : 09; first : $10; next : $00),
(Befehl : ADC; AddType : 10; first : $12; next : $00),
(Befehl : ADC; AddType : 20; first : $80; next : $10),
(Befehl : INC_; AddType : 03; first : $40; next : $00),
(Befehl : INC_; AddType : 06; first : $FE; next : $00),
(Befehl : AAA; AddType : 00; first : $37; next : $00),
(Befehl : DAA; AddType : 00; first : $27; next : $00),
(Befehl : SUB; AddType : 21; first : $4C; next : $00),
(Befehl : SUB; AddType : 09; first : $28; next : $00),
(Befehl : SUB; AddType : 10; first : $2A; next : $00),
(Befehl : SUB; AddType : 20; first : $80; next : $28),
(Befehl : SBB; AddType : 21; first : $1C; next : $00),
(Befehl : SBB; AddType : 09; first : $18; next : $00),
(Befehl : SBB; AddType : 10; first : $1A; next : $00),
(Befehl : SBB; AddType : 20; first : $80; next : $18),
(Befehl : DEC_; AddType : 03; first : $48; next : $00),
(Befehl : DEC_; AddType : 06; first : $FE; next : $00),
(Befehl : NEG; AddType : 06; first : $F6; next : $18),
(Befehl : CMP; AddType : 21; first : $3C; next : $00),
(Befehl : CMP; AddType : 20; first : $80; next : $38),
(Befehl : CMP; AddType : 09; first : $38; next : $00),
(Befehl : CMP; AddType : 10; first : $3A; next : $00),
(Befehl : AAS; AddType : 00; first : $3F; next : $00),
(Befehl : DAS; AddType : 00; first : $2F; next : $00),
(Befehl : MUL; AddType : 06; first : $F6; next : $20),
(Befehl : IMUL; AddType : 06; first : $F6; next : $28),
(Befehl : AAM; AddType : 00; first : $D4; next : $0A),
(Befehl : DIV_; AddType : 06; first : $F6; next : $30),
(Befehl : IDIV; AddType : 06; first : $F6; next : $38),
(Befehl : AAD; AddType : 00; first : $D5; next : $0A),
(Befehl : CBW; AddType : 00; first : $98; next : $00),
(Befehl : CWD; AddType : 00; first : $99; next : $00),
(Befehl : NOT_; AddType : 06; first : $F6; next : $10),
(Befehl : SHL_; AddType : 06; first : $D0; next : $20),
(Befehl : SHL_; AddType : 07; first : $D2; next : $20),
(Befehl : SAL; AddType : 06; first : $D0; next : $20),
(Befehl : SAL; AddType : 07; first : $D2; next : $20),
(Befehl : SHR_; AddType : 06; first : $D0; next : $28),
(Befehl : SHR_; AddType : 07; first : $D2; next : $28),
(Befehl : SAR; AddType : 06; first : $D0; next : $38),
(Befehl : SAR; AddType : 07; first : $D2; next : $38),
(Befehl : ROL; AddType : 06; first : $D0; next : $00),
(Befehl : ROL; AddType : 07; first : $D2; next : $00),
(Befehl : ROR; AddType : 06; first : $D0; next : $08),
(Befehl : ROR; AddType : 07; first : $D2; next : $08),
(Befehl : RCL; AddType : 06; first : $D0; next : $10),
(Befehl : RCL; AddType : 07; first : $D2; next : $10),
(Befehl : RCR; AddType : 06; first : $D0; next : $18),
(Befehl : RCR; AddType : 07; first : $D2; next : $18),
(Befehl : AND_; AddType : 21; first : $24; next : $00),
(Befehl : AND_; AddType : 14; first : $80; next : $20),
(Befehl : AND_; AddType : 09; first : $20; next : $00),
(Befehl : AND_; AddType : 10; first : $22; next : $00),
(Befehl : TEST; AddType : 21; first : $A8; next : $00),
(Befehl : TEST; AddType : 14; first : $F6; next : $00),
(Befehl : TEST; AddType : 09; first : $84; next : $00),
(Befehl : TEST; AddType : 10; first : $84; next : $00),
(Befehl : OR_; AddType : 21; first : $0C; next : $00),
(Befehl : OR_; AddType : 14; first : $80; next : $08),
(Befehl : OR_; AddType : 09; first : $08; next : $00),
(Befehl : OR_; AddType : 10; first : $0A; next : $00),
(Befehl : XOR_; AddType : 21; first : $34; next : $00),
(Befehl : XOR_; AddType : 14; first : $80; next : $30),
(Befehl : XOR_; AddType : 09; first : $30; next : $00),
(Befehl : XOR_; AddType : 10; first : $32; next : $00),
(Befehl : REP; AddType : 00; first : $F2; next : $00),
(Befehl : REPZ; AddType : 00; first : $F3; next : $00),
(Befehl : REPNZ; AddType : 00; first : $F2; next : $00),
(Befehl : REPE; AddType : 00; first : $F3; next : $00),
(Befehl : REPNE; AddType : 00; first : $F2; next : $00),
(Befehl : MOVSB; AddType : 00; first : $A4; next : $00),
(Befehl : CMPSB; AddType : 00; first : $A6; next : $00),
(Befehl : SCASB; AddType : 00; first : $AE; next : $00),
(Befehl : LODSB; AddType : 00; first : $AC; next : $00),
(Befehl : STOSB; AddType : 00; first : $AA; next : $00),
(Befehl : CALL; AddType : 22; first : $E8; next : $00),
(Befehl : CALL; AddType : 05; first : $FF; next : $10),
(Befehl : JMP; AddType : 05; first : $FF; next : $20),
(Befehl : JMP; AddType : 24; first : $E9; next : $00),
(Befehl : RET; AddType : 00; first : $C3; next : $00),
(Befehl : RET; AddType : 01; first : $C2; next : $00),
(Befehl : JE; AddType : 02; first : $74; next : $00),
(Befehl : JZ; AddType : 02; first : $74; next : $00),
(Befehl : JL; AddType : 02; first : $7C; next : $00),
(Befehl : JNGE; AddType : 02; first : $7C; next : $00),
(Befehl : JLE; AddType : 02; first : $7E; next : $00),
(Befehl : JNG; AddType : 02; first : $7E; next : $00),
(Befehl : JB; AddType : 02; first : $72; next : $00),
(Befehl : JNAE; AddType : 02; first : $72; next : $00),
(Befehl : JP; AddType : 02; first : $7A; next : $00),
(Befehl : JPE; AddType : 02; first : $7A; next : $00),
(Befehl : JO; AddType : 02; first : $70; next : $00),
(Befehl : JS; AddType : 02; first : $78; next : $00),
(Befehl : JNE; AddType : 02; first : $75; next : $00),
(Befehl : JNZ; AddType : 02; first : $75; next : $00),
(Befehl : JNL; AddType : 02; first : $7D; next : $00),
(Befehl : JGE; AddType : 02; first : $7D; next : $00),
(Befehl : JNLE; AddType : 02; first : $7F; next : $00),
(Befehl : JG; AddType : 02; first : $7F; next : $00),
(Befehl : JNB; AddType : 02; first : $73; next : $00),
(Befehl : JAE; AddType : 02; first : $73; next : $00),
(Befehl : JNBE; AddType : 02; first : $77; next : $00),
(Befehl : JA; AddType : 02; first : $77; next : $00),
(Befehl : JNP; AddType : 02; first : $7B; next : $00),
(Befehl : JPO; AddType : 02; first : $7B; next : $00),
(Befehl : JNO; AddType : 02; first : $71; next : $00),
(Befehl : JNS; AddType : 02; first : $79; next : $00),
(Befehl : JNA; AddType : 02; first : $76; next : $00),
(Befehl : JBE; AddType : 02; first : $76; next : $00),
(Befehl : LOOP; AddType : 02; first : $E2; next : $00),
(Befehl : LOOPZ; AddType : 02; first : $E1; next : $00),
(Befehl : LOOPE; AddType : 02; first : $E1; next : $00),
(Befehl : LOOPNZ; AddType : 02; first : $E0; next : $00),
(Befehl : LOOPNE; AddType : 02; first : $E0; next : $00),
(Befehl : JCXZ; AddType : 02; first : $E3; next : $00),
(Befehl : INT; AddType : 08; first : $CD; next : $00),
(Befehl : INTO; AddType : 00; first : $CE; next : $00),
(Befehl : IRET; AddType : 00; first : $CF; next : $00),
(Befehl : CLC; AddType : 00; first : $F8; next : $00),
(Befehl : STC; AddType : 00; first : $F9; next : $00),
(Befehl : CMC; AddType : 00; first : $F5; next : $00),
(Befehl : CLD; AddType : 00; first : $FC; next : $00),
(Befehl : CLI; AddType : 00; first : $FA; next : $00),
(Befehl : HLT; AddType : 00; first : $F4; next : $00),
(Befehl : LOCK; AddType : 00; first : $F0; next : $00),
(Befehl : NOP; AddType : 00; first : $90; next : $00),
(Befehl : STD; AddType : 00; first : $FD; next : $00),
(Befehl : STI; AddType : 00; first : $FB; next : $00),
(Befehl : WAIT; AddType : 00; first : $9B; next : $00),
(Befehl : MOVSW; AddType : 00; first : $A5; next : $00),
(Befehl : CMPSW; AddType : 00; first : $A7; next : $00),
(Befehl : SCASW; AddType : 00; first : $AF; next : $00),
(Befehl : LODSW; AddType : 00; first : $AD; next : $00),
(Befehl : STOSW; AddType : 00; first : $AB; next : $00),
(Befehl : CALLF; AddType : 05; first : $FF; next : $18),
(Befehl : CALLF; AddType : 23; first : $9A; next : $00),
(Befehl : JMPF; AddType : 05; first : $FF; next : $28),
(Befehl : JMPF; AddType : 23; first : $EA; next : $00),
(Befehl : RETF; AddType : 00; first : $CB; next : $00),
(Befehl : RETF; AddType : 01; first : $CA; next : $00),
(Befehl : LAHF; AddType : 00; first : $9F; next : $00),
(Befehl : CS; AddType : 00; first : $2E; next : $00),
(Befehl : SS; AddType : 00; first : $36; next : $00),
(Befehl : DS; AddType : 00; first : $3E; next : $00),
(Befehl : ES; AddType : 00; first : $26; next : $00));
WRegs : Array[0..7] of String[2] = ('AX','CX','DX','BX','SP','BP','SI','DI');
BRegs : Array[0..7] of String[2] = ('AL','CL','DL','BL','AH','CH','DH','BH');
SRegs : Array[0..3] of String[2] = ('ES','CS','SS','DS');
MRegs : Array[0..7] of String[6] = ('[BX+SI','[BX+DI','[BP+SI','[BP+DI','[SI','[DI','[BP','[BX');
BWOR : Array[ByteWordType] of Byte = (0,0,1);
Syntax = 1;
type Operands = (nichts,Imm,Regs,EA,SegRegs,Abs,RegCl,RegDX,RegAW);
OperandsType = Set of Operands;
DOperandsType = Set of SetType;
var DOperand : DOperandsType;
ByteWord : ByteWordType;
PutString,
AssemblerCode,Mnemo,
Source,Dest : String[80];
OpAnz,i,Col : Integer;
{---------------------------------------------------------------------------}
procedure Error(Nr : Byte);
begin
WriteLn(^G,'Fehler');
Halt;
end;
{---------------------------------------------------------------------------}
procedure UpString(var Str1 : String);
var i : Integer;
begin
for i := 1 to length(Str1) do Str1[i] := UpCase(Str1[i]);
end;
{---------------------------------------------------------------------------}
function FirstIn(Str1,Str2 : String) : Boolean;
var ip : Integer;
begin
FirstIn := TRUE;
if length(Str1) > length(Str2) then FirstIn := FALSE
else for ip := 1 to length(Str1) do
if Str1[ip] <> Str2[ip] then FirstIn := FALSE
end;
{---------------------------------------------------------------------------}
procedure SplitLine;
var i : Integer;
Len : Byte ABSOLUTE AssemblerCode;
begin
OpAnz := 0;
i := 1;
Mnemo := ''; Source := ''; Dest := '';
while (AssemblerCode[i] <> ' ') AND (i <= Len) do begin
Insert(AssemblerCode[i],Mnemo,255);
Inc(i);
end;
while (AssemblerCode[i] = ' ') AND (i <= Len) do Inc(i);
if i > Len then begin OpAnz := 0; Exit; end;
while (AssemblerCode[i] <> ' ') AND
(AssemblerCode[i] <> ',') AND
(i <= Len) do begin
Insert(AssemblerCode[i],Dest,255);
Inc(i);
end;
if (AssemblerCode[i] = ',') AND (i <= Len) then
if (i < Len) then begin
OpAnz := 2;
Inc(i);
end else Error(Syntax)
else begin OpAnz := 1; Exit; end;
while (AssemblerCode[i] <> ' ') AND (i <= Len) do begin
Insert(AssemblerCode[i],Source,255);
Inc(i);
end
end;
{---------------------------------------------------------------------------}
function TestImm(var Operand : String) : Boolean;
const HexChars : Set of Char = ['0'..'9','A'..'F'];
DezChars : Set of Char = ['-','0'..'9'];
var i : Integer;
Hex : Boolean;
begin
TestImm := TRUE;
Hex := Operand[1] = '$';
if Operand[length(Operand)] = 'H' then delete(Operand,length(Operand),1);
if Operand[1] in ['$','#'] then delete(Operand,1,1);
for i := 1 to length(Operand) do
if (( Hex) AND Not (Operand[i] in HexChars)) OR
((Not Hex) AND Not (Operand[i] in DezChars))
then Error(Syntax);
if Hex then Insert('$',Operand,1);
end;
{---------------------------------------------------------------------------}
function SegOfs(var Adresse : String) : String;
var i : Integer;
OneByte : String[4];
Dummy : String[16];
begin
if (Adresse[0] <> #9) then Error(Syntax); { falsche Länge }
for i := 4 downto 1 do begin
Insert('/$'+copy(Adresse,i SHL 1,2),OneByte,1);
move(OneByte[1],Dummy[(4-i) SHL 2],4);
end;
Dummy[0] := #15;
SegOfs := Dummy;
end;
{---------------------------------------------------------------------------}
procedure GetOperandsType(var Operand : String;
var OpSet : OperandsType;
var BW : ByteWordType);
var i,j : Integer;
begin
OpSet :=[];
BW := NoLen;
if length(Operand) = 2 then begin
i := 7;
while (i >= 0) AND (WRegs[i] <> Operand) do Dec(i);
if i >= 0 then begin
BW := WLen;
OpSet := [Regs,EA];
if i = 0 then OpSet := [Regs,EA,RegAW];
end else begin
i := 7;
while (i >= 0) AND (BRegs[i] <> Operand) do Dec(i);
if i >= 0 then begin
BW := BLen;
OpSet := [Regs,EA];
if i = 0 then OpSet := [Regs,EA,RegAW];
if i = 1 then OpSet := [Regs,EA,RegCL];
end else begin
i := 3;
while (i >= 0) AND (SRegs[i] <> Operand) do Dec(i);
if i >= 0 then OpSet := [SegRegs]
else if TestImm(Operand) then OpSet := [Imm];
end;
end;
end else if Operand = '[DX]' then OpSet := [RegDX] else begin
if Operand[1] = '[' then begin
i := 7;
while (i >= 0) AND NOT FirstIn(MRegs[i],Operand) do Dec(i);
if (i >= 0) AND (Operand[succ(length(MRegs[i]))] in ['+',']','-'])
then OpSet := [EA]
else OpSet := [Abs,EA];
end else begin
if FirstIn('WORD PTR',Operand) then begin
OpSet := [Abs,EA];
BW := WLen;
end else if FirstIn('BYTE PTR',Operand) then begin
OpSet := [Abs,EA];
BW := BLen;
end else if TestImm(Operand) then OpSet := [Imm];
end;
end;
end;
{---------------------------------------------------------------------------}
procedure GetDOperandsType;
var i : integer;
SourceType,
DestType : OperandsType;
BW : ByteWordType;
begin
DOperand := [];
case OpAnz of
0 : DOperand := [0];
1 : begin
GetOperandsType(Dest,DestType,ByteWord);
if Imm in DestType then DOperand := [1,2,8,22,23,24];
if EA in DestType then if ByteWord = BLen then DOperand := [6]
else DOperand := [5,6];
if (Regs in DestType) AND (ByteWord = WLen) then
DOperand := DOperand + [3];
if SegRegs in DestType then DOperand := [4];
end;
2 : begin
GetOperandsType(Dest,DestType,ByteWord);
GetOperandsType(Source,SourceType,BW);
if EA in DestType then begin
if RegCL in SourceType then DOperand := [7];
if Regs in SourceType then DOperand := DOperand + [9];
if SegRegs in SourceType then DOperand := DOperand + [11];
if Imm in SourceType then DOperand := DOperand + [14,20];
end;
if Regs in DestType then begin
if EA in SourceType then DOperand := DOperand + [10];
if Imm in SourceType then DOperand := DOperand + [13];
end;
if (SegRegs in DestType) AND (EA in SourceType) then
DOperand := [12];
if RegAW in DestType then begin
if Abs in SourceType then DOperand := DOperand + [15];
if Imm in SourceType then DOperand := DOperand + [18,21];
if (Regs in SourceType) AND (ByteWord = WLen) then
DOperand := DOperand + [17];
if RegDX in SourceType then DOperand := DOperand + [19];
end;
if (Abs in DestType) AND (RegAW in SourceType) then
DOperand := DOperand + [16];
if ByteWord = NoLen then ByteWord := BW
else if (BW <> NoLen) AND (BW <> ByteWord) AND (Not (7 in DOperand))
then Error(Syntax);
end;
end;
end; { of GetDOperandsType }
{---------------------------------------------------------------------------}
function CheckMnemo : BefehlType;
var Bef : BefehlType;
begin
if length(Mnemo) > 6 then Error(Syntax);
BefBez[NOBEF] := Mnemo;
Bef := MOV;
while Mnemo <> BefBez[Bef] do Inc(Bef);
if Bef = NOBEF then Error(Syntax);
CheckMnemo := Bef;
end;
{---------------------------------------------------------------------------}
function GetBefehl : Integer;
var BefBez : BefehlType;
i : Integer;
begin
BefBez := CheckMnemo;
GetDOperandsType;
for i := 0 to BefAnz do
if (BefBez = BefBytes[i].Befehl) AND
(BefBytes[i].AddType in DOperand) then begin
GetBefehl := i;
exit;
end;
Error(Syntax);
end;
{---------------------------------------------------------------------------}
function Space(len : Byte) : String;
var Dummy : String[80];
begin
FillChar(Dummy[1],Len,32);
Dummy[0] := chr(len);
Space := Dummy;
end;
{---------------------------------------------------------------------------}
procedure InitPut;
begin
PutString := 'INLINE(';
end;
{---------------------------------------------------------------------------}
function HexB(b : Byte) : String;
const Digit : Array[0..15] of Char = '0123456789ABCDEF';
begin
HexB := Digit[b shr 4] + Digit[b AND $0F];
end;
{---------------------------------------------------------------------------}
procedure PutB(B : Byte);
begin
PutString := PutString + '$' + HexB(b) + '/';
end;
{---------------------------------------------------------------------------}
procedure PutS(S : String);
begin
PutString := PutString + S + '/';
end;
{---------------------------------------------------------------------------}
procedure EndPut;
begin
PutString[length(PutString)] := ')';
PutString := PutString + ';' + Space(30-length(PutString)) + '{ '+Mnemo;
case OpAnz of
1 : PutString := PutString + Space(40-length(PutString)) + Dest;
2 : PutString := PutString + Space(40-length(PutString)) + Dest+','+Source;
end;
PutString := PutString + Space(68-length(PutString)) + '}';
end;
{---------------------------------------------------------------------------}
function RegNr(S : String) : Byte;
var i : Byte;
begin
i := 7;
while (i<8) AND (S <> WRegs[i]) AND (S <> BRegs[i]) do Dec(i);
RegNr := i;
end;
{---------------------------------------------------------------------------}
function SegNr(S : String) : Byte;
var i : Byte;
begin
i := 3;
while (i>0) AND (S <> SRegs[i]) do Dec(i);
SegNr := i;
end;
{---------------------------------------------------------------------------}
procedure PutEA(Mask : Byte;OP : String);
var RM,
Modus : Byte;
Disp : String;
begin
RM := RegNr(OP);
if RM < 8 then Modus := 3
else begin
if OP[1] <> '[' then begin
i := pos('[',OP);
if i = 0 then Error(Syntax);
delete(OP,1,pred(i));
end;
i := 0;
while (i < 8) AND NOT FirstIn(MRegs[i],OP) do Inc(i);
if i = 8 then begin
Modus := 0;
RM := 6;
if OP[length(OP)] <> ']' then Error(Syntax);
Disp := copy(OP,2,length(OP)-2);
if Disp[1] <> '>' then insert('>',Disp,1);
end else begin
RM := i;
Disp := copy(OP,succ(length(MRegs[i])),255);
if Disp[1] in ['+',']'] then Delete(Disp,1,1);
if Disp = '' then if RM = 6 then begin
Modus := 1;
Disp := '$00';
end else Modus := 0
else begin
if Disp[length(Disp)] <> ']' then Error(Syntax);
Dec(Disp[0]);
case Disp[1] of
'<' : Modus := 1;
'>' : Modus := 2;
'$' : if TestImm(Disp) then
if length(Disp) < 4 then Modus := 1
else Modus := 2;
'0'..'9',
'-' : begin
val(Disp,i,Col);
if Col <> 0 then Error(Syntax);
if (i >= -128) AND (i <= 127) then Modus := 1
else Modus := 2;
end;
else begin
insert('>',Disp,1);
Modus := 2;
end;
end; { of case }
end;
end;
end;
PutB(Mask OR RM OR Modus SHL 6);
if ((Modus = 0) AND (((Mask OR RM) AND 7) = 6)) OR (Modus = 1) OR (Modus = 2) then PutS(Disp);
end; { of PutEA }
{---------------------------------------------------------------------------}
function ImmLen(var S : String;Flag : Boolean) : Byte;
var i : Integer;
begin
case S[1] of
'<' : ImmLen := 1;
'>' : ImmLen := 0;
'$' : if TestImm(S) then
if length(s) < 4 then ImmLen := 1
else ImmLen := 0;
'0'..'9',
'-' : begin
val(S,i,Col);
if Col <> 0 then Error(Syntax);
if (i >= -128) AND (i <= 127) then ImmLen := 1
else ImmLen := 0;
end;
else begin
ImmLen := 0;
if Flag then insert('>',S,1);
end;
end; { of case }
end; { of ImmLen }
{---------------------------------------------------------------------------}
procedure PutBWS(S : String);
var Len : Byte;
begin
Len := ImmLen(S,TRUE);
if Len <> BWOR[ByteWord] then PutS(S)
else if Len = 0 then Error(Syntax)
else if S[1] = '<' then Error(Syntax)
else PutS(S);
end;
{---------------------------------------------------------------------------}
procedure PutLS(S : String);
var Len : Byte;
begin
Len := ImmLen(S,TRUE);
if Len <> BWOR[ByteWord] then PutS(S)
else if Len = 0 then Error(Syntax)
else if S[1] = '<' then Error(Syntax)
else PutS('>'+S);
end;
{---------------------------------------------------------------------------}
procedure MakeCommand;
var Bef : Integer;
begin
InitPut;
Bef := GetBefehl;
with BefBytes[Bef] do
case AddType of
0 : begin PutB(First); if Next > 0 then PutB(Next) end;
1,22 : begin PutB(First); PutS('>'+Dest) end;
2,8 : begin PutB(First); PutS('<'+Dest) end;
3 : PutB(First OR RegNr(Dest));
4 : PutB(First OR SegNr(Dest) SHL 3);
5 : begin PutB(First); PutEA(Next,Dest) end;
6,7 : begin PutB(First OR BWOR[ByteWord]); PutEA(Next,Dest) end;
9 : begin PutB(First OR BWOR[ByteWord]); PutEA(RegNr(Source) SHL 3,Dest) end;
10 : begin
if (Befehl in [LDS,LEA,LES]) then begin
if (ByteWord <> WLen) then Error(Syntax) { nur 16Bit Register }
else ByteWord := NoLen; { und Tschüß }
end;
PutB(First OR BWOR[ByteWord]); PutEA(RegNr(Dest) SHL 3,Source)
end;
11 : begin PutB(First); PutEA(Next OR SegNr(Source) SHL 3,Dest) end;
12 : begin PutB(First); PutEA(Next OR SegNr(Dest) SHL 3,Source) end;
13 : begin PutB(First OR RegNr(Dest) OR BWOR[ByteWord] SHL 3); PutS(Source) end;
14 : begin PutB(First OR BWOR[ByteWord]); PutEA(Next,Dest); PutLS(Source) end;
15 : begin
PutB(First OR BWOR[ByteWord]);
PutS(copy(Source,2,length(Source)-2))
end;
16 : begin
PutB(First OR BWOR[ByteWord]);
PutS(copy(Dest,2,length(Dest)-2))
end;
17 : PutB(First OR RegNr(Source));
18 : begin PutB(First OR BWOR[ByteWord]); PutS(Source); end;
19 : PutB(First OR BWOR[ByteWord]);
20 : begin PutB(First OR ImmLen(Source,FALSE) SHL 1 OR BWOR[ByteWord]); PutEA(Next,Dest); PutBWS(Source) end;
21 : begin PutB(First OR BWOR[ByteWord]); PutLS(Source); end;
23 : begin PutB(First); PutS(SegOfs(Dest)); end;
24 : begin PutB(First OR ImmLen(Dest,FALSE) SHL 1); PutS(Dest); end;
end; { of case }
EndPut;
end; { of MakeCommand }
{---------------------------------------------------------------------------}
begin { of Assemble }
repeat
Write('Enter mnemonic : ');ReadLn(AssemblerCode);
if length(AssemblerCode) = 0 then Exit;
UpString(AssemblerCode);
SplitLine;
MakeCommand;
WriteLn('Result : ',PutString);
until FALSE;
end;
{-----------------------------------------------------------------------------}
begin
ClrScr;
Assemble;
end.