home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power Programming
/
powerprogramming1994.iso
/
progtool
/
tex
/
webtp55.arc
/
ASM2INL.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1989-12-05
|
55KB
|
1,878 lines
{$R-,S-,I-,F-,V-,B-,N-,A+}
Unit Asm2Inl;
{-Convert assembler instructions to inlines}
{ based on the inline assembler in Inline219 by L. David Baldwin
changed for use with TANGLE, 3.8.89 Peter Sawatzki
28 Vers 2.20 Fix sign extension bug, 4.8.89 PS
------------ 17-27: L. David Baldwin ---------
27 Vers 2.19 Fix CMP AX,-1, etc., incorrect in Vers 2.18.
26 Vers 2.18 Implement the sign extension bit for some instructions
25 Vers 2.17 Convert to Turbo 4.
24 Vers 2.16 Change byte size check in MemReg so the likes of
MOV [DI+$FE],AX will assemble right.
Allow ',' in DB pseudo op instruction.
23 Vers 2.15 Fix 'shl cl,1' which assembled as shl cl,cl
22 Vers 2.14 Change output format to better accomodate map file line numbers.
21 Vers 2.13 Allow JMP SHORT direct using symbols.
20 Vers 2.12 Allow CALL and JMP direct using symbols.
19 Vers 2.11
Fix bug in CallJmp and ShortJmp which didn't restrict short
jump range properly.
Fix bug which didn't allow CALL or JMP register. (CALL BX).
18 Vers 2.1
Fix bug in Accum which occasionally messed up IN and OUT instr.
Fix unintialized function in getnumber for quoted chars.
17 Vers 2.03
Change GetSymbol to accept about anything after '>' or '<'
Add 'NEW' pseudoinstruction.
Fix serious bug in defaultextension.
Add Wait_Already to prevent 2 'WAIT's from occuring.
Use 'tindex<maxbyte' comparison rather than <= which won't work
with integer comparison in this case.
}
Interface
Const
Maxbyte = 4000; {MaxInt}
InBufMax = 4000;
Var
TextArray : Array[0..Maxbyte] Of Char;
Procedure SetupAsm;
Function FeedAsm(Ch : Char) : Boolean;
Function DoAsm(InsertComments : Boolean) : Boolean;
Function ObjSize : Word;
Implementation
Const
Symbolleng = 32; {maximum of 32 char symbols}
CR = 13; Lf = 10; Tab = 9;
BigStringSize = 127;
Type
SymString = String[Symbolleng];
IndxReg = (BX, SI, DI, BP, None);
IndxSet = Set Of IndxReg;
PtrType = (BPtr, WPtr, DwPtr, QwPtr, TbPtr, UnkPtr); {keep order}
String4 = String[4];
String5 = Array[1..5] Of Char;
Symtype = (Address, Disp8, Disp16, Othersym, EOLsym, Identifier, JmpDist,
LfBrack, RtBrack, Plus, Comma, STsym);
BigString = String[BigStringSize]; {125 chars on a turbo line}
Label_Info_ptr = ^Label_Info;
Label_Info = Record
Name : SymString;
ByteCnt : Integer;
Next : Label_Info_ptr;
End;
Fixup_Info_Ptr = ^Fixup_Info;
Fixup_Info = Record
Name : SymString;
Indx, Indx2, Fix_pt : Integer;
Jmptype : (Short, Med);
Prev, Next : Fixup_Info_Ptr;
End;
Var
InBufEnd : 0..InBufMax;
InBuf : Array[0..InBufMax] Of Char;
StartChi : Word;
EofInstr : Boolean;
NoAddrs, Aerr, Symbol, TheEnd, NewFnd, St_first,
Displace, WordSize, Wait_Already : Boolean;
Addr : Integer;
Sym : Symtype;
Reg1, Reg2, W1, W2: byte;
ModeByte,Sti_val : Integer;
SaveOfs, DataVal : Record
Symb : Boolean;
Sname : SymString;
Value : Integer;
End;
IRset : IndxSet;
Rmm, Md : Integer;
ByWord : PtrType;
Byt, SignExt : Byte;
Tindex, Tindex0, Column, ByteCount, LastSlash : Integer;
TokStr : SymString;
UCh, LCh : Char;
Chi, OldChi : Integer;
Start_Col : Integer;
Firstlabel, Pl : Label_Info_ptr;
Firstfix, Pf : Fixup_Info_Ptr;
Function GetStr(p : Word) : String;
Var
s : String;
Begin
s := '';
Dec(p);
While (p < InBufEnd) And (InBuf[p] <> '/') Do Begin
Inc(Byte(s[0]));
s[Length(s)] := InBuf[p];
Inc(p);
End;
GetStr := s
End;
Procedure InsertStr(s : BigString); Forward;
Procedure Error(s : BigString);
Begin
If Not Aerr Then Begin
WriteLn;
WriteLn(GetStr(StartChi));
Write('':(Start_Col+(Chi-StartChi)),'^Error');
If Length(s) > 0 Then
Write(': ', s);
WriteLn;
Aerr := True;
InsertStr('{!Error: '+s+'}'); {-mark error in source file}
End;
End;
Procedure SetupAsm;
Begin
InBufEnd := 0;
End;
Function FeedAsm(Ch : Char) : Boolean;
Begin
If InBufEnd = InBufMax Then
FeedAsm := False
Else Begin
FeedAsm := True;
InBuf[InBufEnd] := Ch;
Inc(InBufEnd)
End
End;
{the following are definitions and variables for the parser}
Var
Segm, NValue : Integer;
Symname : SymString;
{end of parser defs}
Procedure GetCh;
{return next char in uch and lch with uch in upper case.}
Begin
If Chi < InBufEnd Then Begin
LCh := InBuf[Chi];
If LCh = '/' Then
LCh := Chr(CR);
UCh := Upcase(LCh);
Inc(Chi);
End Else Begin
LCh := Chr(CR);
UCh := Chr(CR);
TheEnd := True
End;
End;
Procedure SkipSpaces;
Begin
While (UCh = ' ') Or (UCh = Chr(Tab)) Do GetCh;
End;
Function GetDec(Var V : Integer) : Boolean;
Const
Ssize = 8;
Var
s: String[Ssize];
Getd: Boolean;
Code: Integer;
Begin
Getd := False;
s := '';
While (UCh >= '0') And (UCh <= '9') Do
Begin
Getd := True;
If Ord(s[0]) < Ssize Then s := s+UCh;
GetCh;
End;
If Getd Then
Begin
Val(s, V, Code);
If Code <> 0 Then Error('Bad number format');
End;
GetDec := Getd;
End;
Function GetHex(Var H : Integer) : Boolean;
Var
Digit: Integer; {check for '$' before the call}
Begin
H := 0; GetHex := False;
While (UCh In ['A'..'F', '0'..'9']) Do
Begin
GetHex := True;
If (UCh >= 'A') Then Digit := Ord(UCh)-Ord('A')+10
Else Digit := Ord(UCh)-Ord('0');
If H And $F000 <> 0 Then Error('Overflow');
H := (H Shl 4)+Digit;
GetCh;
End;
End;
Function GetNumber(Var N : Integer) : Boolean;
{get a number and return it in n}
Var Term : Char;
Err : Boolean;
Begin
N := 0;
If UCh = '(' Then GetCh; {ignore ( }
If (UCh = '''') Or (UCh = '"') Then
Begin
GetNumber := True;
Term := UCh; GetCh; Err := False;
While (UCh <> Term) And Not Err Do Begin
Err := N And $FF00 <> 0;
N := (N Shl 8)+Ord(LCh);
GetCh;
If Err Then Error('Overflow')
End;
GetCh; {use up termination char}
End
Else If UCh = '$' Then
Begin {a hex number}
GetCh;
If Not GetHex(N) Then Error('Hex number exp');
GetNumber := True;
End
Else
GetNumber := GetDec(N); {maybe a decimal number}
If UCh = ')' Then GetCh; {ignore an ending parenthesis}
End;
Function GetExpr(Var Rslt : Integer) : Boolean;
Var
Rs1, Rs2, SaveChi : Integer;
Pos, Neg : Boolean;
Begin
SaveChi := Chi;
GetExpr := False;
SkipSpaces;
Neg := UCh = '-';
Pos := UCh = '+';
If Pos Or Neg Then GetCh;
If GetNumber(Rs1) Then
Begin
GetExpr := True;
If Neg Then Rs1 := -Rs1;
If (UCh = '+') Or (UCh = '-') Then
If GetExpr(Rs2) Then
Inc(Rs1, Rs2); {getexpr will take care of sign}
Rslt := Rs1;
End
Else
Begin
Chi := SaveChi-1; GetCh;
End;
End;
{$v+}
Function GetSymbol(Var s : SymString) : Boolean;
Const
Symchars : Set Of Char = ['@'..'Z', '0'..'9', '_', '+', '-', '$', '*'];
Begin
If UCh In Symchars Then
Begin
GetSymbol := True;
s[0] := Chr(0);
While UCh In Symchars Do
Begin
If Ord(s[0]) < Symbolleng Then s := s+UCh;
GetCh;
End
End
Else GetSymbol := False;
End;
{$v-}
Function GetAddress : Boolean;
Var
Result : Boolean;
SaveChi : Integer;
Begin
Result := False; SaveChi := Chi;
If GetExpr(Segm) Then
Begin
SkipSpaces;
If UCh = ':' Then
Begin
GetCh; SkipSpaces;
Result := GetExpr(NValue);
End;
End;
GetAddress := Result;
If Not Result Then
Begin Chi := SaveChi-1; GetCh; End;
End;
Procedure ErrNull;
Begin Error(''); End;
Procedure ErrIncorrect;
Begin Error('Incorrect or No Operand'); End;
Procedure SegmErr;
Begin Error('Segm Reg not Permitted'); End;
Procedure WordReg;
Begin Error('Word Reg Exp'); End;
Procedure DataLarge;
Begin Error('Data Too Large'); End;
Procedure Chk_BwPtr;
Begin
If ByWord >= DwPtr Then Error('BYTE or WORD Req''d');
End;
Function ByteSize(Val : Integer) : Boolean;
{return true if val is a byte}
Begin
ByteSize := (Hi(Val) = 0) Or (Val And $FF80 = $FF80);
End;
Function ShortSize(Val : Integer) : Boolean;
{return true if val is ShortInt size}
Begin
ShortSize := (Val >= -128) And (Val <= 127);
End;
Function ReadByte : Boolean;
Var Rb : Boolean;
Begin
Rb := GetExpr(NValue);
If Rb Then
If ByteSize(NValue) Then
Byt := Lo(NValue)
Else DataLarge;
ReadByte := Rb;
End;
Function RetIndex (keyword,inst: String; var index: Byte): boolean;
Var
p: Byte;
Begin
While KeyWord[Length(KeyWord)]=' ' Do
Dec(Byte(KeyWord[0]));
KeyWord:= KeyWord+'.';
if KeyWord='.' Then
KeyWord:= '$never$';
p:= Pos(KeyWord,inst);
RetIndex:= p>0;
Index:= 0;
While p>0 Do Begin
If inst[p]='.' Then
Inc(index);
Dec(p)
End
End;
Procedure GetString;
{Fill in TokStr, str, id2,id3. They are, in fact, all in the
same locations}
Var
I: Integer;
Begin
SkipSpaces;
TokStr := ' ';
I := 1;
While (UCh >= '@') And (UCh <= 'Z')
Or (UCh >= '0') And (UCh <= '9') Do Begin
If I <= Symbolleng Then Begin
TokStr[I]:= UCh;
Inc(I);
End;
GetCh;
End;
TokStr[0] := Chr(I-1);
End;
Procedure InsertChr(C : Char);
Begin
If Tindex < Maxbyte Then
Begin
TextArray[Tindex] := C;
Inc(Tindex); Inc(Column);
End
Else
Begin
WriteLn('Object Code Overflow!');
Halt(1);
End;
End;
Procedure InsertStr(s : BigString);
Var I : Integer;
Begin
For I := 1 To Ord(s[0]) Do InsertChr(s[I]);
End;
Function Hex2(B : Byte) : String4;
Const HexDigs : Array[0..15] Of Char = '0123456789ABCDEF';
Var Bz : Byte;
Begin
Bz := B And $F; B := B Shr 4;
Hex2 := HexDigs[B]+HexDigs[Bz];
End;
Function Hex4(W : Integer) : String4;
Begin Hex4 := Hex2(Lo(W))+Hex2(Hi(W)); End;
Procedure InsertByte(B : Byte);
Begin
InsertStr('$'+Hex2(B));
ByteCount := ByteCount+1;
LastSlash := Tindex;
InsertChr('/');
Wait_Already := False; {any byte inserted cancels a WAIT}
End;
Procedure InsertWord(W : Integer);
Begin
InsertByte(Lo(W)); InsertByte(Hi(W));
End;
Procedure InsertHi_Low(W : Integer);
{insert a word in reverse order}
Begin
InsertByte(Hi(W)); InsertByte(Lo(W));
End;
Procedure InsertWait;
Begin {Insert a 'WAIT' for Fl Pt only if none already input}
If Not Wait_Already Then InsertByte($9B);
End;
Procedure Modify_Byte(I : Integer; Modify : Byte);
{Modify an ascii byte string in textarray by adding modify to its value}
Var
St : String4;
J : Integer;
Function HexToByte(I : Integer; Var J : Integer) : Byte;
{Starting at tindex, i, convert hex to a byte. return j, the tindex where
byte started}
Var
Result, Tmp : Byte;
K : Integer;
C : Char;
Const
Hex : Set Of Char = ['0'..'9', 'A'..'F'];
Begin
Result := 0;
While Not(TextArray[I] In Hex) Do Inc(I); {skip '/' and '$'}
J := I;
For K := I To I+1 Do Begin
C := TextArray[K];
If C <= '9' Then Tmp := Ord(C)-Ord('0') Else Tmp := Ord(C)-Ord('A')+10;
Result := (Result Shl 4)+Tmp
End;
HexToByte := Result
End;
Begin
St := Hex2(HexToByte(I, J)+Modify);
TextArray[J] := St[1];
TextArray[J+1] := St[2]
End;
Procedure DoNext;
Var
TmpCh: Char;
Begin
OldChi := Chi;
Symbol := False;
If Sym = EOLsym Then Exit; {do nothing}
SkipSpaces; {note commas are significant}
If (UCh = Chr(CR)) Or (UCh = ';') Then
Sym := EOLsym
Else
If UCh = ',' Then Begin
Sym := Comma;
GetCh
End Else
If (UCh = '>') Or (UCh = '<') Then Begin
TmpCh := UCh;
GetCh;
If Not GetSymbol(Symname) Then Error('Symbol Name Exp');
If TmpCh = '<' Then
Sym := Disp8
Else
Sym := Disp16;
Symbol := True {disp8/16 is a symbol}
End Else
If GetAddress Then
If NoAddrs Then
ErrNull
Else
Sym := Address
Else
If GetExpr(NValue) Then
If ByteSize(NValue) Then
Sym := Disp8
Else
Sym := Disp16
Else
If (UCh >= '@') And (UCh <= 'Z') Then Begin
GetString;
Symname := TokStr;
If (TokStr = 'FAR') Or (TokStr = 'NEAR')
Or (TokStr = 'SHORT') Then
Sym := JmpDist
Else
If TokStr = 'ST' Then
Sym := STsym
Else
Sym := Identifier
End Else
If UCh = '+' Then Begin
Sym := Plus;
GetCh
End Else
If UCh = '[' Then Begin
Sym := LfBrack;
GetCh
End Else
If UCh = ']' Then Begin
Sym := RtBrack;
GetCh
End Else Begin
Sym:= Othersym;
GetCh
End
End;
Procedure NextA;
{-Get the next item but also process any
'WORD' 'BYTE', 'DWORD', 'QWORD',etc 'PTR'}
Var
Indx: Byte;
Const
TheInst = 'BYTE.WORD.DWORD.QWORD.TBYTE.';
Begin
DoNext;
If Sym = Identifier Then
If RetIndex(TokStr,TheInst,Indx) Then Begin
ByWord:= PtrType(Indx);
DoNext;
If TokStr = 'PTR' Then
DoNext {ignore 'PTR'}
End
End;
Procedure Displace_Bytes(W : Integer);
Var C: Char;
Begin
If Displace Then With SaveOfs Do Begin
If Symb Then Begin
{-displacement is a symbol}
If W = 1 Then
C := '>'
Else
C := '<';
InsertStr(C+Sname);
If Value <> 0 Then {Add it in too, don't reverse bytes}
InsertStr('+$'+Hex2(Hi(Value))+Hex2(Lo(Value)));
If W = 1 Then
Inc(ByteCount, 2)
Else
Inc(ByteCount);
LastSlash := Tindex;
InsertChr('/')
End Else
If W = 1 Then
InsertWord(Value)
Else
InsertByte(Lo(Value))
End
End;
Procedure Data_Bytes(WordSize : Boolean);
Var
C: Char;
Begin
With DataVal Do Begin
If Symb Then Begin {data is a symbol}
If WordSize Then
C := '>'
Else
C := '<';
InsertStr(C+Sname);
If Value <> 0 Then {add it in too}
InsertStr('+$'+Hex2(Hi(Value))+Hex2(Lo(Value)));
If WordSize Then
Inc(ByteCount, 2)
Else
Inc(ByteCount);
LastSlash:= Tindex;
InsertChr('/');
End Else
If WordSize Then
InsertWord(Value)
Else
InsertByte(Lo(Value))
End
End;
Function GetIR : Boolean;
Var
Indx: Byte;
Const
TheInst = 'BX.SI.DI.BP.';
Begin
GetIR := False;
If (Sym = Identifier) Then
If RetIndex(TokStr,TheInst,Indx) Then Begin
IRset:= IRset+[IndxReg(Indx)];
GetIR := True;
NextA;
End
End;
Function MemReg(Var W : Byte) : Boolean;
Label
Abort;
{Does not handle the 'reg' part of the mem/reg. Returns disp true if
a displacement is found with w=0 for byte disp and w=1 for word
disp. Any displacement is output in saveofs.}
Var
SaveChi : Integer;
Dsp16, OldAddrs, Result_MemReg : Boolean;
Begin
SaveChi:= OldChi;
Dsp16:= False;
Result_MemReg:= False;
OldAddrs:= NoAddrs;
NoAddrs:= True;
SaveOfs.Value := 0;
SaveOfs.Symb := False;
IRset := [];
{',' or cr terminate a MemReg}
While (Sym <> Comma) And (Sym <> EOLsym) Do Begin
If Sym = LfBrack Then Begin
Result_MemReg := True;
NextA
End;
If Sym = Plus Then NextA;
If (Sym = Disp8) Or (Sym = Disp16) Then With SaveOfs Do Begin
Dsp16 := Dsp16 Or (Sym = Disp16);
If Symbol Then Begin
Symb := True;
Sname := Symname
End Else
Inc(Value, NValue);
NextA;
End Else
If Not GetIR Then
If Sym = RtBrack Then
NextA
Else
If Result_MemReg Then Begin
Error('Comma or Line End Exp');
NextA
End
Else
GoTo Abort
End; {While}
If Result_MemReg Then Begin
{-at least one '[' found}
If (IRset = []) Or (IRset = [BP]) Then Rmm := 6
Else If IRset = [BX, SI] Then Rmm := 0
Else If IRset = [BX, DI] Then Rmm := 1
Else If IRset = [BP, SI] Then Rmm := 2
Else If IRset = [BP, DI] Then Rmm := 3
Else If IRset = [SI] Then Rmm := 4
Else If IRset = [DI] Then Rmm := 5
Else If IRset = [BX] Then Rmm := 7
Else Error('Bad Register Combination');
NextA; {pass over any commas}
With SaveOfs Do
Dsp16 := Dsp16 Or (Symb And (Value <> 0)) Or Not ShortSize(Value);
If IRset = [] Then Begin
Displace := True;
Md := 0;
W := 1
End {direct address} Else
If (IRset = [BP]) And Not Dsp16 Then Begin
Displace := True;
Md := 1;
W := 0
End {bp must have displ} Else
If (SaveOfs.Value = 0) And Not SaveOfs.Symb Then Begin
Displace := False;
Md := 0;
W := 3
End Else
If Not Dsp16 Then {8 bit} Begin
Displace := True;
Md := 1;
W := 0
End Else Begin
Displace := True;
Md := 2;
W := 1
End;
ModeByte := 64*Md+Rmm
End Else Begin {not a MemReg}
Abort: Chi := SaveChi-1; GetCh; {restore as in beginning}
NextA
End;
NoAddrs := OldAddrs;
MemReg := Result_MemReg
End;
Function St_St : Boolean; {pick up st,st(i) or st(i),st or just st(i)}
Var
Err, Rslt : Boolean;
Function GetSti_Val : Boolean;
Var
Grslt: Boolean;
Begin
NextA;
Grslt := Sym = Disp8;
If Grslt Then Begin
Sti_val := NValue;
Err := ((Sti_val And $F8) <> 0); {check limit of 7}
NextA
End;
GetSti_Val := Grslt
End;
Begin
Err := False;
Rslt := Sym = STsym;
If Rslt Then Begin
If GetSti_Val Then Begin
St_first := False; {st(i) is first}
While (Sym = Comma) Or (Sym = STsym) Do NextA;
End Else Begin
St_first := True; {st preceeds st(i)}
If Sym = Comma Then NextA;
If Sym=STsym Then Begin
If Not GetSti_Val Then
Err := True
End Else
Err:= True;
If Err Then
ErrNull
End
End;
St_St := Rslt
End;
Function FstiOnly : Boolean;
{-Fl Pt instructions having only one form using st(i) operand
faddp,fmulp,fsubp,fsubrp,fdivp,fdivrp,ffree,fxch -- 0..7}
Var
Indx : Byte;
Rslt : Boolean;
Const
Stiary : Array[0..7] of Word =
($DEC0, $DEC8, $DEE8, $DEE0, $DEF8, $DEF0, $DDC0, $D9C8);
TheInst = 'FADDP.FMULP.FSUBP.FSUBRP.FDIVP.FDIVRP.FFREE.FXCH.';
Begin
Rslt:= RetIndex(TokStr,TheInst,Indx);
If Rslt Then Begin
NextA;
If Not St_St Then Begin
If Sym = EOLsym Then
Sti_val := 1
Else
ErrIncorrect
End;
InsertWait;
InsertHi_Low(Stiary[Indx]+Sti_val)
End;
FstiOnly := Rslt
End;
Function FmemOnly : Boolean;
{-Fl Pt instructions having only one form using a memory operand}
{fldenv,fldcw,fstenv,fstcw,fbstp,fbld,frstor,fsave,fstsw,
fnsave,fnstcw,fnstenv,fnstsw--0..12 }
Var Indx : Byte;
Rslt : Boolean;
Const
Memary: Array [0..12] of Word = (
$D920, $D928, $D930, $D938, $DF30, $DF20, $DD20, $DD30, $DD38,
$DD30, $D938, $D930, $DD38);
TheInst = 'FLDENV.FLDCW.FSTENV.FSTCW.FBSTP.FBLD.FRSTOR.FSAVE.'+
'FSTSW.FNSAVE.FNSTCW.FNSTENV.FNSTSW.';
Begin
Rslt:= RetIndex(TokStr,TheInst,Indx);
If Rslt Then Begin
NextA;
If Indx < 9 Then InsertWait; {fwait}
If MemReg(W1) Then Begin
InsertHi_Low(Memary[Indx]+ModeByte);
Displace_Bytes(W1)
End Else
ErrIncorrect
End;
FmemOnly := Rslt;
End;
Function FldType : Boolean;
{Do fld,fst,fstp-- 0..2}
Type
Arraytype = Array[0..2, DwPtr..UnkPtr] Of Word;
Var
Indx: Byte;
Tmp: Word;
Rslt : Boolean;
Const
Fldarray : Arraytype = (
($D900, $DD00, $DB28, $D9C0),
($D910, $DD10, 0, $DDD0),
($D918, $DD18, $DB38, $DDD8));
TheInst = 'FLD.FST.FSTP.';
Begin
Rslt:= RetIndex(TokStr,TheInst,Indx);
If Rslt Then Begin
NextA;
InsertWait; {fwait}
If ByWord >= DwPtr Then
Tmp:= Fldarray[Indx, ByWord];
If MemReg(W1) Then Begin
If (ByWord >= DwPtr) And (ByWord <= TbPtr) Then Begin
InsertHi_Low(Tmp+ModeByte);
Displace_Bytes(W1);
If Tmp = 0 Then Error('TBYTE not Permitted')
End Else
Error('DWORD, QWORD, or TBYTE Req''d')
End Else
If St_St Then
InsertHi_Low(Tmp+Sti_val)
Else
ErrIncorrect
End;
FldType := Rslt;
End;
Function FildType : Boolean;
{-do fild,fist,fistp-- 0..2}
Type
Arraytype = Array[0..2, WPtr..QwPtr] Of Word;
Var
Indx: Byte;
Tmp: Word;
Rslt : Boolean;
Const
Fildarray : Arraytype = (
($DF00, $DB00, $DF28),
($DF10, $DB10, 0),
($DF18, $DB18, $DF38));
TheInst = 'FILD.FIST.FISTP.';
Begin
Rslt:= RetIndex(TokStr,TheInst,Indx);
If Rslt Then Begin
NextA;
If MemReg(W1) Then Begin
If (ByWord >= WPtr) And (ByWord <= QwPtr) Then Begin
InsertWait; {fwait}
Tmp := Fildarray[Indx, ByWord];
InsertHi_Low(Tmp+ModeByte);
Displace_Bytes(W1);
If Tmp = 0 Then Error('QWORD not Permitted')
End Else
Error('WORD, DWORD, or QWORD Req''d')
End Else
ErrIncorrect
End;
FildType := Rslt;
End;
Function FaddType : Boolean;
{-The fadd,fmul,fcom,fcomp,fsub,fsubr,fdiv,fdivr instructions}
Var
Indx: Byte;
Rslt : Boolean;
Const
TheInst = 'FADD.FMUL.FCOM.FCOMP.FSUB.FSUBR.FDIV.FDIVR.';
Begin
Rslt := RetIndex(TokStr,TheInst,Indx);
If Rslt Then Begin
NoAddrs := True;
NextA;
InsertWait; {fwait}
If MemReg(W1) Then Begin
If ByWord = DwPtr Then
InsertByte($D8)
Else
If ByWord = QwPtr Then
InsertByte($DC)
Else
Error('DWORD or QWORD Req''d');
InsertByte(ModeByte+8*Indx);
Displace_Bytes(W1)
End Else
If St_St Then Begin
{-Must be st,st(i) or st(i),st }
If St_first Or (Indx = 2 {fcom} ) Or (Indx = 3 {fcomp} ) Then
InsertByte($D8)
Else
InsertByte($DC);
ModeByte := $C0+8*Indx+Sti_val;
If Not St_first And (Indx >= 6 {fdiv} ) Then
ModeByte := ModeByte Xor 8; {reverse fdiv,fdivr for not st_first}
InsertByte(ModeByte)
End Else
ErrIncorrect
End;
FaddType := Rslt
End;
Function FiaddType : Boolean;
{the fiadd,fimul,ficom,ficomp,fisub,fisubr,fidiv,fidivr instructions}
Var
Indx: Byte;
Rslt: Boolean;
Const
TheInst = 'FIADD.FIMUL.FICOM.FICOMP.FISUB.FISUBR.FIDIV.FIDIVR.';
Begin
Rslt := RetIndex(TokStr,TheInst,Indx);
If Rslt Then Begin
NoAddrs := True;
NextA;
If MemReg(W1) Then Begin
InsertWait; {fwait}
If ByWord = DwPtr Then
InsertByte($DA)
Else
If ByWord = WPtr Then
InsertByte($DE)
Else
Error('WORD or DWORD Req''d');
InsertByte(ModeByte+8*Indx);
Displace_Bytes(W1)
End Else
ErrIncorrect
End;
FiaddType := Rslt
End;
Function Fnoperand : Boolean;
{-do the Fl Pt no operand instructions}
Var
Indx: Byte;
Rslt: Boolean;
Const
TheInst =
'FNOP.FCHS.FABS.FTST.FXAM.FLD1.FLDL2T.FLDL2E.FLDPI.FLDLG2.FLDLN2.FLDZ.'+
'F2XM1.FYL2X.FPTAN.FPATAN.FXTRACT.FDECSTP.FINCSTP.FPREM.FYL2XP1.FSQRT.'+
'FRNDINT.FSCALE.FENI.FDISI.FCLEX.FINIT.FCOMPP.FNCLEX.FNDISI.FNENI.FNINIT.';
Fnopcode : Array[0..32] Of Word =
($D9D0, $D9E0, $D9E1, $D9E4, $D9E5, $D9E8,
$D9E9, $D9EA, $D9EB, $D9EC, $D9ED, $D9EE,
$D9F0, $D9F1, $D9F2, $D9F3, $D9F4, $D9F6,
$D9F7, $D9F8, $D9F9, $D9FA, $D9FC, $D9FD,
$DBE0, $DBE1, $DBE2, $DBE3, $DED9,
$DBE2, $DBE1, $DBE0, $DBE3);
Begin
Rslt:= RetIndex(TokStr,TheInst,Indx);
If Rslt Then Begin
NextA;
If Indx < 29 Then InsertWait; {fwait}
InsertHi_Low(Fnopcode[Indx]);
End;
Fnoperand := Rslt
End;
Function Register(Var R, W : Byte) : Boolean;
Const
TheInst = 'AL.CL.DL.BL.AH.CH.DH.BH.'+
'AX.CX.DX.BX.SP.BP.SI.DI.';
Begin
Register:= False;
If (Sym=Identifier) Then
If RetIndex(TokStr,TheInst,R) Then Begin
Register:= True;
NextA;
If Sym = Comma Then NextA;
W:= R Div 8; {w=1 for word type register}
R:= R And 7
End
End;
Function SegRegister(Var R : Byte) : Boolean;
Var
Result_Segr : Boolean;
Const
TheInst = 'ES.CS.SS.DS.';
Begin
SegRegister:= False;
If (Sym = Identifier) Then
If RetIndex(TokStr,TheInst,R) Then Begin
SegRegister:= True;
NextA;
If Sym = Comma Then
NextA;
End
End;
Function Data(Var Wd : Boolean) : Boolean;
{-See if immediate data is present. Set wd if data found is word size}
Var SaveChi : Integer;
Result : Boolean;
Begin
Result := False; Wd := False;
SaveChi := OldChi;
With DataVal Do Begin
Value := 0;
Symb := False;
While (Sym = Disp8) Or (Sym = Disp16) Do Begin
Result := True;
If Symbol Then Begin
Wd := Wd Or (Sym = Disp16);
Symb := True;
Sname := Symname
End Else
Inc(Value, NValue);
NextA;
If Sym = Plus Then NextA
End;
Result := (Sym = EOLsym) And Result;
Wd := Wd Or Not ByteSize(Value)
End;
Data := Result;
If Not Result Then Begin
Chi := SaveChi-1;
GetCh;
NextA
End
End;
Function TwoOperands : Boolean;
{-Handles codes with two operands}
Type
InsType = (Mov, Adc, Addx, Andx, Cmp, Orx, Sbb, Sub, Xorx, Test, Xchg, Lds, Les, Lea);
Codetype = Array[Mov..Lea] Of Byte;
Shcodetype = Array[Mov..Test] Of Byte;
Var
Inst : InsType;
Tmp : Byte;
Const
TheInst = 'MOV.ADC.ADD.AND.CMP.OR.SBB.SUB.XOR.TEST.XCHG.LDS.LES.LEA.';
Immedop : Codetype = ($C6,$80,$80,$80,$80,$80,$80,$80,$80,$F6,$00,$00,$00,$00);
Immedreg : Codetype = ($00,$10,$00,$20,$38,$08,$18,$28,$30,$00,$00,$00,$00,$00);
Memregop : Codetype = ($88,$10,$00,$20,$38,$08,$18,$28,$30,$84,$86,$C5,$C4,$8D);
Shimmedop: Shcodetype=($00,$14,$04,$24,$3C,$0C,$1C,$2C,$34,$A8);
Function ChkSignExt(WordSize : Boolean) : Byte; {Thanx to Jim LeMay}
Begin
If (Immedop[Inst] = $80) And Not WordSize And ShortSize(DataVal.Value) Then
ChkSignExt := 2 { the sign extension bit }
Else ChkSignExt := 0; { no sign extension bit }
End;
Begin
TwoOperands:= False;
if not RetIndex(TokStr,TheInst,Byte(Inst)) Then
Exit;
TwoOperands:= True;
NoAddrs:= True;
NextA;
If Register(Reg1, W1) Then Begin
If Register(Reg2, W2) Then Begin
{-mov reg,reg}
If Inst >= Lds Then Error('Register not Permitted');
If W1 <> W2 Then Error('Registers Incompatible');
If (Inst = Xchg) And ((W1 = 1) And ((Reg1 = 0) Or (Reg2 = 0))) Then
InsertByte($90+Reg1+Reg2)
Else Begin
InsertByte(Memregop[Inst]+W1);
InsertByte($C0+Reg1+8*Reg2);
End
End Else
If SegRegister(Reg2) Then Begin
{-mov reg,segreg}
If (W1 = 0) Or (Inst <> Mov) Then SegmErr;
InsertByte($8C); InsertByte($C0+8*Reg2+Reg1);
End Else
If Data(WordSize) Then Begin
{-mov reg,data}
If Inst >= Xchg Then Error('Immediate not Permitted');
If (Ord(WordSize) > W1) Then DataLarge;
SignExt := ChkSignExt(W1 = 1); {the sign extension bit}
If (Inst = Mov) Then
InsertByte($B0+8*W1+Reg1)
Else
If (Reg1 = 0) {ax or al} Then Begin
InsertByte(Shimmedop[Inst]+W1); {add ac,immed}
SignExt := 0; {no sign extenstion for AL,AX}
End Else Begin
InsertByte(Immedop[Inst]+W1+SignExt);
InsertByte($C0+Immedreg[Inst]+Reg1);
End;
{-output the immediate data}
Data_Bytes((SignExt = 0) And (W1 > 0))
End Else
If MemReg(W2) Then Begin
{-mov reg,mem/reg}
If (Inst = Mov) And (Reg1 = 0) {ax or al} And (Rmm = 6) And (Md = 0) Then
{-mov ac,mem}
InsertByte($A0+W1)
Else Begin
Tmp := Memregop[Inst];
If Inst <= Xchg Then Begin
Inc(Tmp,W1);
If Inst <> Test Then Tmp := Tmp Or 2 {to,from bit}
End;
InsertByte(Tmp);
InsertByte(ModeByte+8*Reg1)
End;
Displace_Bytes(W2) {add on any displacement bytes}
End Else
ErrNull
End Else
If SegRegister(Reg1) Then Begin
If Inst <> Mov Then
SegmErr;
InsertByte($8E);
If Register(Reg2, W2) Then Begin
{-mov segreg,reg}
If (W2 = 0) Then
WordReg;
InsertByte($C0+8*Reg1+Reg2)
End Else
If MemReg(W2) Then Begin
{-mov segreg,mem/reg}
InsertByte(ModeByte+8*Reg1);
Displace_Bytes(W2) {add any displacement bytes}
End Else
ErrNull
End Else
If MemReg(W1) And (Inst <= Xchg) Then Begin
If Register(Reg2, W2) Then Begin
{-mov mem/reg,reg}
If (W2 > Ord(ByWord)) Then Error('Byte Reg Exp');
If (Inst = Mov) And (Reg2 = 0) {ax or al}
And (Rmm = 6) And (Md = 0) Then {mov ac, mem}
InsertByte($A2+W2)
Else Begin
InsertByte(Memregop[Inst]+W2);
InsertByte(ModeByte+8*Reg2)
End;
Displace_Bytes(W1)
End Else
If SegRegister(Reg2) Then Begin
{-mov mem/reg,segreg}
If (Inst <> Mov) Then SegmErr;
InsertByte($8C);
InsertByte(ModeByte+8*Reg2);
Displace_Bytes(W1)
End Else
If (Data(WordSize)) And (Inst < Xchg) Then Begin
{-mov mem/reg, data}
Chk_BwPtr;
If (Ord(WordSize) > Ord(ByWord)) Then DataLarge;
SignExt:= ChkSignExt(ByWord = WPtr); {the sign extension bit}
InsertByte(Immedop[Inst]+Ord(ByWord)+SignExt);
InsertByte(ModeByte+Immedreg[Inst]);
Displace_Bytes(W1); {add displacement bytes}
Data_Bytes((SignExt = 0) And (ByWord = WPtr)); {the immediate data}
End Else
ErrNull
End Else
If (Sym = Disp8) Or (Sym = Disp16) Then
Error('Immediate not Permitted')
Else
ErrNull
End;
Function OneOperand: Boolean;
{Handles codes with one operand}
Type
InsType = (Dec, Inc, Push, Pop, Nott, Neg);
Codetype = Array[Dec..Neg] Of Byte;
Var
Inst : InsType;
Pushpop : Boolean;
Const
TheInst = 'DEC.INC.PUSH.POP.NOT.NEG.';
Regop : Codetype = ($48,$40,$50,$58,$00,$00);
Segregop : Codetype = ($00,$00,$06,$07,$00,$00);
Memregop : Codetype = ($FE,$FE,$FF,$8F,$F6,$F6);
Memregcode : Codetype = ($08,$00,$30,$00,$10,$18);
Begin
OneOperand := False;
If Not RetIndex(TokStr,TheInst,Byte(Inst)) Then
Exit;
OneOperand := True;
Pushpop := (Inst = Push) Or (Inst = Pop);
NoAddrs := True;
NextA;
If Register(Reg1, W1) Then
If (W1 = 1) And (Inst < Nott) Then
{-16 bit register instructions}
InsertByte(Regop[Inst]+Reg1)
Else Begin
{-byte register or neg,not with any reg}
InsertByte(Memregop[Inst]+W1);
InsertByte($C0+Memregcode[Inst]+Reg1);
If Pushpop Then
WordReg;
End
Else
If SegRegister(Reg1) Then Begin
{-segment reg--push,pop only}
InsertByte(Segregop[Inst]+8*Reg1);
If Not Pushpop Then SegmErr
End Else
If MemReg(W1) Then Begin
{-memreg (not register)}
If Not Pushpop Then Chk_BwPtr;
InsertByte(Memregop[Inst] Or Ord(ByWord));
InsertByte(ModeByte+Memregcode[Inst]);
Displace_Bytes(W1);
End Else
ErrIncorrect;
End;
Function NoOperand : Boolean;
{-Those instructions consisting only of opcode}
Const
Nmbsop = 31;
Type
Opfield = Array[0..Nmbsop] Of Byte;
Var
Index : Byte;
Const
TheInst = 'DAA.AAA.NOP.MOVSB.MOVSW.CMPSB.CMPSW.XLAT.HLT.'
+'CMC.DAS.AAS.CBW.CWD.PUSHF.POPF.SAHF.LAHF.'
+'STOSB.STOSW.LODSB.LODSW.SCASB.SCASW.INTO.IRET.'+
+'CLC.STC.CLI.STI.CLD.STD.';
Opcode: Opfield = (
$27, $37, $90, $A4, $A5, $A6, $A7, $D7, $F4,
$F5, $2F, $3F, $98, $99, $9C, $9D, $9E, $9F, $AA, $AB, $AC, $AD,
$AE, $AF, $CE, $CF, $F8, $F9, $FA, $FB, $FC, $FD);
Begin
NoOperand := False;
If Not RetIndex(TokStr,TheInst,Index) Then
Exit;
NoOperand := True;
InsertByte(Opcode[Index]);
NextA;
End;
Function Prefix : Boolean;
{process the prefix instructions}
Const
Nmbsop = 11;
Type
Opfield = Array[0..Nmbsop] Of Byte;
Var
Index: Byte;
SaveWait : Boolean;
Opc : Byte;
Const
TheInst = 'LOCK.REP.REPZ.REPNZ.REPE.REPNE.WAIT.FWAIT.ES.DS.CS.SS.';
Opcode: Opfield = ($F0,$F2,$F3,$F2,$F3,$F2,$9B,$9B,$26,$3E,$2E,$36);
Begin
Prefix := False;
if Not RetIndex(TokStr,TheInst,Index) Then
Exit;
Prefix:= True;
Opc := Opcode[Index];
SaveWait := Wait_Already; {save any WAIT already programed}
InsertByte(Opc);
Wait_Already := SaveWait Or (Opc = $9B); {set for WAIT or FWAIT}
Tindex0 := Tindex; {for future fix ups}
If UCh = ':' Then GetCh; {es: etc permitted with a colon}
End;
Function FindLabel(Var B : Integer) : Boolean;
{-Find a label if it exists in the label chain}
Var
Found : Boolean;
Begin
Pl:= Firstlabel;
Found:= False;
While (Pl <> Nil) And Not Found Do
With Pl^ Do
If Symname = Name Then Begin
Found := True;
B := ByteCnt
End Else
Pl := Next;
FindLabel:= Found
End;
Function ShortJmp : Boolean;
{-short jump instructions}
Const
Numjmp = 34;
Type
Opfield = Array[0..Numjmp] Of Byte;
Var
I: Byte;
B: Integer;
Const
TheInst = 'JO.JNO.JB.JNAE.JNB.JAE.JE.JZ.JNE.JNZ.JBE.JNA.'
+'JNBE.JA.LOOPN.LOOPZ.LOOPE.LOOP.JCXZ.JS.JNS.JP.JPE.'
+'JNP.JPO.JL.JNGE.JNL.JGE.JLE.JNG.JNLE.JG.JC.JNC.';
Opcode : Opfield = (
$70, $71, $72, $72, $73, $73, $74, $74, $75, $75, $76, $76,
$77, $77, $E0, $E1, $E1, $E2, $E3, $78, $79, $7A, $7A, $7B,
$7B, $7C, $7C, $7D, $7D, $7E, $7E, $7F, $7F, $72, $73);
Begin
ShortJmp := False;
If Not RetIndex(TokStr,TheInst,i) Then
Exit;
ShortJmp := True;
NoAddrs := True;
InsertByte(Opcode[I]);
NextA;
If Sym = Identifier Then Begin
If FindLabel(B) Then Begin
Addr := B-(ByteCount+1);
If (Addr <= $7F) And (Addr >= -128) Then
InsertByte(Lo(Addr))
Else
Error('Too Far')
End Else Begin
{-enter jump into fixups}
New(Pf);
With Pf^ Do Begin
Next := Firstfix;
If Firstfix <> Nil Then
Firstfix^.Prev := Pf;
Firstfix := Pf;
Prev := Nil;
Jmptype := Short;
Name := Symname;
Fix_pt := ByteCount; Indx := Tindex;
InsertByte(0) {dummy insertion}
End
End;
NextA
End Else
Error('Label Exp')
End;
Function ShfRot : Boolean;
Type
InsType = (Rclx, Rcrx, Rolx, Rorx, Salx, Sarx, Shlx, Shrx);
Codetype = Array[Rclx..Shrx] Of Byte;
Var
Inst : InsType;
CL : Byte;
Const
TheInst = 'RCL.RCR.ROL.ROR.SAL.SAR.SHL.SHR.';
Regcode : Codetype = ($10, $18, 0, 8, $20, $38, $20, $28);
Begin
ShfRot:= False;
If Not RetIndex(TokStr,TheInst,Byte(Inst)) Then
Exit;
ShfRot:= True;
NoAddrs := True;
NextA;
InsertByte($D0); {may get modified later}
If Register(Reg1, W1) Then
InsertByte($C0+Regcode[Inst]+Reg1)
Else
If MemReg(W2) Then Begin
Chk_BwPtr;
W1:= Ord(ByWord);
InsertByte(ModeByte+Regcode[Inst]);
Displace_Bytes(W2);
End Else
Error('Reg or Mem Exp');
If Sym = Comma Then NextA;
CL := 0;
If (Sym = Identifier) And (TokStr = 'CL') Then
CL := 2
Else
If NValue <> 1 Then Error('CL or 1 Exp');
NextA;
Modify_Byte(Tindex0, CL+W1); {modify the opcode}
End;
Function CallJmp : Boolean;
Type
InsType = (CALL, JMP);
Codetype = Array[CALL..JMP] Of Byte;
Var
Inst : InsType;
Dist : (Long, Shrt, Near,NoDist);
Tmp : Byte;
Dwtmp : PtrType;
B : Integer;
WordSize : Boolean;
Const
TheInst = 'CALL.JMP.';
TheDist = 'FAR.NEAR.SHORT.';
Shortop : Codetype = ($E8, $E9);
Longop : Codetype = ($9A, $EA);
Longcode : Codetype = ($18, $28);
Shortcode : Codetype = ($10, $20);
Begin
CallJmp := False;
if not RetIndex(TokStr,TheInst,Byte(Inst)) Then
Exit;
CallJmp := True;
NextA;
Dist := Nodist;
Dwtmp := ByWord; {could have passed a 'DWORD PTR' here}
If Sym = JmpDist Then Begin
If Not RetIndex(TokStr,TheDist,Byte(Dist)) Then
Dist:= NoDist;
NextA
End;
If (Sym = Address) Then Begin
InsertByte(Longop[Inst]);
InsertWord(NValue);
InsertWord(Segm);
End Else
If Register(Reg1, W1) Then Begin
If W1 = 0 Then WordReg;
If Dist = Long Then Error('FAR not Permitted');
InsertByte($FF);
InsertByte($C0+Shortcode[Inst]+Reg1);
End Else
If Sym = Identifier Then Begin
If Dist = Long Then Error('Far not Permitted with Label');
If FindLabel(B) Then Begin
Addr := B-(ByteCount+2);
If Inst = CALL Then Begin
InsertByte($E8);
InsertWord(Addr-1)
End Else
If (Addr <= $7F) And (Addr >= -128) And (Dist <> Near) Then Begin
{-short jump}
InsertByte($EB);
InsertByte(Lo(Addr))
End Else Begin
InsertByte($E9);
InsertWord(Addr-1)
End
End {findlabel} Else Begin
{enter it into fixup chain}
New(Pf);
With Pf^ Do Begin
Next := Firstfix;
If Firstfix <> Nil Then
Firstfix^.Prev := Pf;
Firstfix := Pf;
Prev := Nil;
Name := Symname;
If Dist = Shrt Then Begin
Jmptype := Short;
InsertByte($EB);
Fix_pt := ByteCount;
Indx := Tindex;
InsertByte(0); {dummy insertion}
End Else Begin
Jmptype := Med;
If Inst = CALL Then InsertByte($E8) Else InsertByte($E9);
Fix_pt := ByteCount; Indx := Tindex;
InsertByte(0); {dummy insertion}
Indx2 := Tindex;
InsertByte(0) {another dummy byte}
End
End {With Pf^}
End
End {identifier} Else
If Data(WordSize) Then Begin
{Direct CALL or JMP}
If (Inst=JMP) And (Dist=Shrt) Then Begin
If WordSize Then Error('Must be byte size');
InsertByte($EB);
Data_Bytes(False);
End Else Begin
If Not((Dist = Nodist) Or (Dist = Near)) Or (Dwtmp <> UnkPtr) Then
Error('Only NEAR permitted');
If Not WordSize Then Error('Must be word size');
InsertByte(Shortop[Inst]);
Data_Bytes(True)
End
End Else
If MemReg(W1) Then Begin
If (Dist = Long) Or (Dwtmp = DwPtr) Then
Tmp := Longcode[Inst]
Else
Tmp := Shortcode[Inst];
InsertByte($FF);
InsertByte(ModeByte+Tmp);
Displace_Bytes(W1)
End Else
ErrNull;
NextA
End;
Procedure Retrn(Far : Boolean);
Const
RetCodes1: array[boolean] of Byte = ($C2,$CA);
RetCodes2: array[boolean] of Byte = ($C3,$CB);
Begin
If (Sym = Disp16) Or (Sym = Disp8) Then Begin
InsertByte(RetCodes1[Far]);
InsertWord(NValue);
NextA
End Else
InsertByte(RetCodes2[Far])
End;
Function OtherInst : Boolean;
Type
Instsym = (Ret,Retf,Aam,Aad,Inn,Out,Mul,Imul,Divd,Idiv,Int);
Var
Index: Instsym;
Tmp: Byte;
Const
TheInst = 'RET.RETF.AAM.AAD.IN.OUT.MUL.IMUL.DIV.IDIV.INT.';
Procedure MulDiv(B : Byte);
Var
Wordbit: Integer;
Begin
InsertByte($F6);
If Register(Reg2, W2) Then Begin
InsertByte($C0+B+Reg2);
Wordbit := W2;
End Else
If MemReg(W2) Then Begin
Chk_BwPtr;
Wordbit := Ord(ByWord);
InsertByte(ModeByte+B);
Displace_Bytes(W2)
End Else
Error('Reg or Mem Exp');
Modify_Byte(Tindex0, Wordbit)
End;
Function DXreg : Boolean;
Begin
DXreg := False;
If Sym = Identifier Then
If TokStr = 'DX' Then Begin
DXreg := True;
NextA
End
End;
Function Accum(Var W : Byte) : Boolean;
Var
Result_acc : Boolean;
{See if next is AL or AX}
Begin
Result_acc := False;
If (Sym = Identifier) Then Begin
Result_acc:= (TokStr = 'AX') Or (TokStr = 'AL');
If Result_acc Then Begin
If TokStr[2] = 'X' Then
W := 1
Else
W := 0; {word vs byte register}
NextA
End
End;
Accum:= Result_acc
End;
Begin
OtherInst := False;
if not RetIndex(TokStr,TheInst,Byte(Index)) Then
Exit;
OtherInst := True;
NextA;
Case Index Of
Ret : Retrn(False);
Retf : Retrn(True);
Out : Begin
If DXreg Then
InsertByte($EE) {out dx,ac}
Else
If Sym = Disp8 Then Begin
{out port,ac}
InsertByte($E6);
InsertByte(Lo(NValue));
NextA
End Else
Error('DX or Port Exp');
If Sym = Comma Then NextA;
If Accum(W1) Then
Modify_Byte(Tindex0, W1) {al or ax}
Else
Error('AX or AL Exp')
End;
Inn : Begin
If Accum(W1) Then Begin
If Sym = Comma Then NextA;
If DXreg Then
InsertByte($EC+W1) {in ac,dx}
Else Begin
If Sym = Disp8 Then Begin {in ac,port}
InsertByte($E4+W1);
InsertByte(Lo(NValue));
NextA;
End Else
Error('DX or Port Exp')
End
End Else
Error('AX or AL Exp')
End;
Aam : Begin
InsertByte($D4);
Insertbyte($0A)
End;
Aad : Begin
InsertByte($D5);
InsertByte($0A)
End;
Mul : MulDiv($20);
Imul : MulDiv($28);
Divd : MulDiv($30);
Idiv : MulDiv($38);
Int : If Sym = Disp8 Then Begin
If NValue = 3 Then
InsertByte($CC)
Else Begin
InsertByte($CD);
InsertByte(Lo(NValue))
End;
NextA
End Else
ErrNull;
End;
End;
Function GetQuoted(Var Ls : BigString) : Boolean;
Var SaveChi, K : Integer;
Term : Char;
Gq : Boolean;
Begin
SkipSpaces;
SaveChi := Chi; K := 1;
Gq := False;
If (UCh = '''') Or (UCh = '"') Then Begin
Term := UCh; GetCh;
While (UCh <> Term) And (UCh <> Chr(CR)) Do
If (UCh <> Chr(CR)) And (K <= BigStringSize) Then Begin
Ls[K]:= LCh;
Inc(K);
GetCh
End;
GetCh; {pass by term}
Gq := Not(UCh In ['+', '-', '*', '/']) {else was meant to be expr}
End;
Ls[0] := Chr(K-1);
If Not Gq Then Begin
Chi := SaveChi-1;
GetCh
End;
GetQuoted := Gq
End;
Procedure DataByte;
Var
I: Integer;
Lst: BigString;
Begin
Repeat
If GetQuoted(Lst) Then
For I := 1 To Ord(Lst[0]) Do
InsertByte(Lo(Ord(Lst[I])))
Else
If ReadByte Then
InsertByte(Byt)
Else
ErrNull;
While (UCh = ' ') Or (UCh = Chr(Tab)) Or (UCh = ',') Do GetCh;
Until (UCh = Chr(CR)) Or (UCh = ';') Or Aerr;
NextA;
End;
Procedure Chk_For_Label;
Var
Dum1, Dum2 : Byte;
Begin
If Not Prefix Then Begin
{-could be prefix here}
SkipSpaces;
If (TokStr[0] > Chr(0)) And (UCh = ':') Then Begin
{-label found}
Sym := Identifier;
If Register(Dum1, Dum2) Then
Error('Register name used as label')
Else Begin
GetCh;
Symname := TokStr;
Pl:= Firstlabel; {check for duplication of label}
While Pl <> Nil Do With Pl^ Do Begin
If Symname = Name Then Error('Duplicate Label');
Pl := Next
End;
New(Pl); {add the label to the label chain}
With Pl^ Do Begin
Next:= Firstlabel;
Firstlabel:= Pl;
ByteCnt:= ByteCount;
Name:= Symname
End;
Pf := Firstfix; {see if any fixups are required}
While Pf <> Nil Do With Pf^ Do Begin
If Name = Symname Then Begin
{-remove this fixup from chain}
If Pf = Firstfix Then
Firstfix := Next
Else
Prev^.Next := Next;
If Next <> Nil Then Next^.Prev := Prev;
Dispose(Pf);
Addr := ByteCount-(Fix_pt+1);
If Jmptype = Short Then
If Addr+$80 <= $FF Then
Modify_Byte(Indx, Lo(Addr))
Else
Error('Too Far')
Else Begin
{-jmptype=med}
Dec(Addr);
Modify_Byte(Indx, Lo(Addr));
Modify_Byte(Indx2, Hi(Addr))
End
End;
Pf := Next
End
End; {label found}
GetString; {for next item to use}
End
End {neither a label or a prefix} Else
GetString {it was a prefix}
End;
Procedure Interpret;
Begin
Tindex0 := Tindex; {opcode position}
GetString;
Chk_For_Label;
While Prefix Do {process any prefix instructions}
GetString;
If Length(TokStr)=0 Then
NextA {if not a string find out what}
Else
If NoOperand
Or OneOperand
Or TwoOperands
Or ShortJmp
Or CallJmp
Or ShfRot
Or OtherInst
Or FaddType
Or Fnoperand
Or FiaddType
Or FldType
Or FmemOnly
Or FildType
Or FstiOnly Then
{void}
Else
If TokStr='DB' Then
DataByte
Else
If TokStr = 'NEW' Then Begin
NewFnd := True;
NextA
End Else
If TokStr = 'END' Then Begin
TheEnd := True;
NextA
End Else
Error('Unknown Instruction');
If Sym <> EOLsym Then Error('End of Line Exp');
End;
Function DoAsm(InsertComments : Boolean) : Boolean;
Var
s : String;
Procedure LabelReport; {Report any fixups not made and restore heap}
Var
Pftmp : Fixup_Info_Ptr;
Pltmp : Label_Info_ptr;
Begin
Pf := Firstfix;
While Pf <> Nil Do With Pf^ Do Begin
WriteLn('Label not Found-- ', Name);
DoAsm := False;
Pftmp := Next;
Dispose(Pf);
Pf := Pftmp
End;
Pl := Firstlabel;
While Pl <> Nil Do Begin
Pltmp := Pl^.Next;
Dispose(Pl);
Pl := Pltmp
End
End;
Begin {DoAsm}
Wait_Already := False;
EofInstr := False;
NewFnd := True;
TheEnd := False;
Tindex := 0;
Chi := 0;
DoAsm := True; {-we assume there's no error}
While NewFnd And Not TheEnd Do Begin
NewFnd := False;
Start_Col := 1;
ByteCount := 0;
Firstlabel := Nil; Firstfix := Nil;
(* InsertStr('inline(');
* if InsertComments then
* InsertStr(^m^j);
*)
While Not TheEnd And Not NewFnd Do Begin
Aerr:= False; NoAddrs := False;
ByWord:= UnkPtr;
Column:= 0;
GetCh;
Sym := Othersym;
SkipSpaces;
If UCh <> Chr(CR) Then Begin {skip blank lines}
StartChi := Chi;
Interpret;
If Aerr Then {-mark error}
DoAsm := False;
If InsertComments And Not NewFnd Then Begin
s := GetStr(StartChi);
If s <> '' Then
InsertStr(#9'{'+s+'}'^m^J)
End;
If Column>72 Then Begin
InsertStr(^m^j);
Column:= 0
End
End;
If TheEnd Or NewFnd Then {-Fix up the last '/' inserted}
TextArray[LastSlash] := ' '
End;
LabelReport {report any fixups not made and dispose all heap items}
End
End;
Function ObjSize : Word;
Begin
ObjSize := Tindex
End;
End.