1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297 |
- {
- $Id$
- Copyright (c) 1996,97 by Florian Klaempfl
- This unit implements an asmoutput class for Intel syntax with Intel i386+
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ****************************************************************************
- }
- unit ag386int;
- interface
- uses aasm,assemble;
- type
- pi386intasmlist=^ti386intasmlist;
- ti386intasmlist = object(tasmlist)
- procedure WriteTree(p:paasmoutput);virtual;
- procedure WriteAsmList;virtual;
- end;
- implementation
- uses
- dos,globals,systems,cobjects,i386,
- strings,files,verbose
- {$ifdef GDB}
- ,gdb
- {$endif GDB}
- ;
- const
- line_length = 70;
- extstr : array[EXT_NEAR..EXT_ABS] of String[8] =
- ('NEAR','FAR','PROC','BYTE','WORD','DWORD',
- 'CODEPTR','DATAPTR','FWORD','PWORD','QWORD','TBYTE','ABS');
- function double2str(d : double) : string;
- var
- hs : string;
- p : byte;
- begin
- str(d,hs);
- { nasm expects a lowercase e }
- p:=pos('E',hs);
- if p>0 then
- hs[p]:='e';
- p:=pos('+',hs);
- if p>0 then
- delete(hs,p,1);
- double2str:=lower(hs);
- end;
- function extended2str(e : extended) : string;
- var
- hs : string;
- p : byte;
- begin
- {$ifdef VER0_99_5}
- str(double(e),hs);
- {$else}
- str(e,hs);
- {$endif}
- { nasm expects a lowercase e }
- p:=pos('E',hs);
- if p>0 then
- hs[p]:='e';
- p:=pos('+',hs);
- if p>0 then
- delete(hs,p,1);
- extended2str:=lower(hs);
- end;
- function comp2str(d : bestreal) : string;
- type
- pdouble = ^double;
- var
- c : comp;
- dd : pdouble;
- begin
- {$ifdef TP}
- c:=d;
- {$else}
- c:=comp(d);
- {$endif}
- dd:=pdouble(@c); { this makes a bitwise copy of c into a double }
- comp2str:=double2str(dd^);
- end;
- function getreferencestring(const ref : treference) : string;
- var
- s : string;
- first : boolean;
- begin
- if ref.isintvalue then
- s:= tostr(ref.offset)
- else
- with ref do
- begin
- first:=true;
- if ref.segment<>R_DEFAULT_SEG then
- s:=int_reg2str[segment]+':['
- else
- s:='[';
- if assigned(symbol) then
- begin
- s:=s+symbol^;
- first:=false;
- end;
- if (base<>R_NO) then
- begin
- if not(first) then
- s:=s+'+'
- else
- first:=false;
- s:=s+int_reg2str[base];
- end;
- if (index<>R_NO) then
- begin
- if not(first) then
- s:=s+'+'
- else
- first:=false;
- s:=s+int_reg2str[index];
- if scalefactor<>0 then
- s:=s+'*'+tostr(scalefactor);
- end;
- if offset<0 then
- s:=s+tostr(offset)
- else if (offset>0) then
- s:=s+'+'+tostr(offset);
- s:=s+']';
- end;
- getreferencestring:=s;
- end;
- function getopstr(t : byte;o : pointer;s : topsize; _operator: tasmop;dest : boolean) : string;
- var
- hs : string;
- begin
- case t of
- top_reg : getopstr:=int_reg2str[tregister(o)];
- top_const,
- top_ref : begin
- if t=top_const then
- hs := tostr(longint(o))
- else
- hs:=getreferencestring(preference(o)^);
- { can possibly give a range check error under tp }
- { if using in... }
- if ((_operator <> A_LGS) and (_operator <> A_LSS) and
- (_operator <> A_LFS) and (_operator <> A_LDS) and
- (_operator <> A_LES)) then
- Begin
- case s of
- S_B : hs:='byte ptr '+hs;
- S_W : hs:='word ptr '+hs;
- S_L : hs:='dword ptr '+hs;
- S_IS : hs:='word ptr '+hs;
- S_IL : hs:='dword ptr '+hs;
- S_IQ : hs:='qword ptr '+hs;
- S_FS : hs:='dword ptr '+hs;
- S_FL : hs:='qword ptr '+hs;
- S_FX : hs:='tbyte ptr '+hs;
- S_BW : if dest then
- hs:='word ptr '+hs
- else
- hs:='byte ptr '+hs;
- S_BL : if dest then
- hs:='dword ptr '+hs
- else
- hs:='byte ptr '+hs;
- S_WL : if dest then
- hs:='dword ptr '+hs
- else
- hs:='word ptr '+hs;
- end;
- end;
- getopstr:=hs;
- end;
- top_symbol : begin
- hs[0]:=chr(strlen(pchar(pcsymbol(o)^.symbol)));
- move(pchar(pcsymbol(o)^.symbol)^,hs[1],byte(hs[0]));
- hs:='offset '+hs;
- if pcsymbol(o)^.offset>0 then
- hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
- else
- if pcsymbol(o)^.offset<0 then
- hs:=hs+tostr(pcsymbol(o)^.offset);
- getopstr:=hs;
- end;
- else
- internalerror(10001);
- end;
- end;
- function getopstr_jmp(t : byte;o : pointer) : string;
- var
- hs : string;
- begin
- case t of
- top_reg : getopstr_jmp:=int_reg2str[tregister(o)];
- top_ref : getopstr_jmp:=getreferencestring(preference(o)^);
- top_const : getopstr_jmp:=tostr(longint(o));
- top_symbol : begin
- hs[0]:=chr(strlen(pchar(pcsymbol(o)^.symbol)));
- move(pchar(pcsymbol(o)^.symbol)^,hs[1],byte(hs[0]));
- if pcsymbol(o)^.offset>0 then
- hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
- else
- if pcsymbol(o)^.offset<0 then
- hs:=hs+tostr(pcsymbol(o)^.offset);
- getopstr_jmp:=hs;
- end;
- else
- internalerror(10001);
- end;
- end;
- {****************************************************************************
- TI386INTASMLIST
- ****************************************************************************}
- var
- LastSec : tsection;
- const
- ait_const2str:array[ait_const_32bit..ait_const_8bit] of string[8]=
- (#9'DD'#9,'',#9'DW'#9,#9'DB'#9);
- ait_section2masmstr : array[tsection] of string[6]=
- ('','CODE','DATA','BSS','');
- Function PadTabs(p:pchar;addch:char):string;
- var
- s : string;
- i : longint;
- begin
- i:=strlen(p);
- if addch<>#0 then
- begin
- inc(i);
- s:=StrPas(p)+addch;
- end
- else
- s:=StrPas(p);
- if i<8 then
- PadTabs:=s+#9#9
- else
- PadTabs:=s+#9;
- end;
- procedure ti386intasmlist.WriteTree(p:paasmoutput);
- type
- twowords=record
- word1,word2:word;
- end;
- var
- s,
- prefix,
- suffix : string;
- hp : pai;
- counter,
- lines,
- i,j,l : longint;
- consttyp : tait;
- found,
- quoted : boolean;
- begin
- if not assigned(p) then
- exit;
- hp:=pai(p^.first);
- while assigned(hp) do
- begin
- case hp^.typ of
- ait_comment : Begin
- AsmWrite(target_asm.comment);
- AsmWritePChar(pai_asm_comment(hp)^.str);
- AsmLn;
- End;
- ait_regalloc,
- ait_regdealloc :;
- ait_section : begin
- if LastSec<>sec_none then
- AsmWriteLn('_'+ait_section2masmstr[LastSec]+#9#9'ENDS');
- if pai_section(hp)^.sec<>sec_none then
- begin
- AsmLn;
- AsmWriteLn('_'+ait_section2masmstr[pai_section(hp)^.sec]+#9#9+
- 'SEGMENT'#9'PARA PUBLIC USE32 '''+
- ait_section2masmstr[pai_section(hp)^.sec]+'''');
- end;
- LastSec:=pai_section(hp)^.sec;
- end;
- ait_align : begin
- { CAUSES PROBLEMS WITH THE SEGMENT DEFINITION }
- { SEGMENT DEFINITION SHOULD MATCH TYPE OF ALIGN }
- { HERE UNDER TASM! }
- AsmWriteLn(#9'ALIGN '+tostr(pai_align(hp)^.aligntype));
- end;
- ait_external : AsmWriteLn(#9'EXTRN'#9+StrPas(pai_external(hp)^.name)+
- ' :'+extstr[pai_external(hp)^.exttyp]);
- ait_datablock : begin
- if pai_datablock(hp)^.is_global then
- AsmWriteLn(#9'PUBLIC'#9+StrPas(pai_datablock(hp)^.name));
- AsmWriteLn(PadTabs(pai_datablock(hp)^.name,#0)+'DB'#9+tostr(pai_datablock(hp)^.size)+' DUP(?)');
- end;
- ait_const_32bit,
- ait_const_8bit,
- ait_const_16bit : begin
- AsmWrite(ait_const2str[hp^.typ]+tostr(pai_const(hp)^.value));
- consttyp:=hp^.typ;
- l:=0;
- repeat
- found:=(not (Pai(hp^.next)=nil)) and (Pai(hp^.next)^.typ=consttyp);
- if found then
- begin
- hp:=Pai(hp^.next);
- s:=','+tostr(pai_const(hp)^.value);
- AsmWrite(s);
- inc(l,length(s));
- end;
- until (not found) or (l>line_length);
- AsmLn;
- end;
- ait_const_symbol : begin
- AsmWrite(#9#9+'DD '#9'offset ');
- AsmWritePChar(pchar(pai_const(hp)^.value));
- AsmLn;
- end;
- ait_real_32bit : AsmWriteLn(#9#9'DD'#9+double2str(pai_single(hp)^.value));
- ait_real_64bit : AsmWriteLn(#9#9'DQ'#9+double2str(pai_double(hp)^.value));
- ait_real_extended : AsmWriteLn(#9#9'DT'#9+extended2str(pai_extended(hp)^.value));
- ait_comp : AsmWriteLn(#9#9'DQ'#9+comp2str(pai_extended(hp)^.value));
- ait_string : begin
- counter := 0;
- lines := pai_string(hp)^.len div line_length;
- { separate lines in different parts }
- if pai_string(hp)^.len > 0 then
- Begin
- for j := 0 to lines-1 do
- begin
- AsmWrite(#9#9'DB'#9);
- quoted:=false;
- for i:=counter to counter+line_length do
- begin
- { it is an ascii character. }
- if (ord(pai_string(hp)^.str[i])>31) and
- (ord(pai_string(hp)^.str[i])<128) and
- (pai_string(hp)^.str[i]<>'"') then
- begin
- if not(quoted) then
- begin
- if i>counter then
- AsmWrite(',');
- AsmWrite('"');
- end;
- AsmWrite(pai_string(hp)^.str[i]);
- quoted:=true;
- end { if > 31 and < 128 and ord('"') }
- else
- begin
- if quoted then
- AsmWrite('"');
- if i>counter then
- AsmWrite(',');
- quoted:=false;
- AsmWrite(tostr(ord(pai_string(hp)^.str[i])));
- end;
- end; { end for i:=0 to... }
- if quoted then AsmWrite('"');
- AsmWrite(target_os.newline);
- counter := counter+line_length;
- end; { end for j:=0 ... }
- { do last line of lines }
- AsmWrite(#9#9'DB'#9);
- quoted:=false;
- for i:=counter to pai_string(hp)^.len-1 do
- begin
- { it is an ascii character. }
- if (ord(pai_string(hp)^.str[i])>31) and
- (ord(pai_string(hp)^.str[i])<128) and
- (pai_string(hp)^.str[i]<>'"') then
- begin
- if not(quoted) then
- begin
- if i>counter then
- AsmWrite(',');
- AsmWrite('"');
- end;
- AsmWrite(pai_string(hp)^.str[i]);
- quoted:=true;
- end { if > 31 and < 128 and " }
- else
- begin
- if quoted then
- AsmWrite('"');
- if i>counter then
- AsmWrite(',');
- quoted:=false;
- AsmWrite(tostr(ord(pai_string(hp)^.str[i])));
- end;
- end; { end for i:=0 to... }
- if quoted then
- AsmWrite('"');
- end;
- AsmLn;
- end;
- ait_label : begin
- if pai_label(hp)^.l^.is_used then
- begin
- AsmWrite(lab2str(pai_label(hp)^.l));
- if (assigned(hp^.next) and not(pai(hp^.next)^.typ in
- [ait_const_32bit,ait_const_16bit,ait_const_8bit,ait_const_symbol,
- ait_real_32bit,ait_real_64bit,ait_real_extended,ait_string])) then
- AsmWriteLn(':');
- end;
- end;
- ait_direct : begin
- AsmWritePChar(pai_direct(hp)^.str);
- AsmLn;
- end;
- ait_labeled_instruction : AsmWriteLn(#9#9+int_op2str[pai_labeled(hp)^._operator]+#9+lab2str(pai_labeled(hp)^.lab));
- ait_symbol : begin
- if pai_symbol(hp)^.is_global then
- AsmWriteLn(#9'PUBLIC'#9+StrPas(pai_symbol(hp)^.name));
- AsmWritePChar(pai_symbol(hp)^.name);
- if assigned(hp^.next) and not(pai(hp^.next)^.typ in
- [ait_const_32bit,ait_const_16bit,ait_const_8bit,ait_const_symbol,
- ait_real_64bit,ait_real_extended,ait_string]) then
- AsmWriteLn(':')
- end;
- ait_instruction : begin
- suffix:='';
- prefix:= '';
- { added prefix instructions, must be on same line as opcode }
- if (pai386(hp)^.op1t = top_none) and
- ((pai386(hp)^._operator = A_REP) or
- (pai386(hp)^._operator = A_LOCK) or
- (pai386(hp)^._operator = A_REPE) or
- (pai386(hp)^._operator = A_REPNE)) then
- Begin
- prefix:=int_op2str[pai386(hp)^._operator]+#9;
- hp:=Pai(hp^.next);
- { this is theorically impossible... }
- if hp=nil then
- begin
- s:=#9#9+prefix;
- AsmWriteLn(s);
- break;
- end;
- end
- else
- prefix:= '';
- if pai386(hp)^.op1t<>top_none then
- begin
- if pai386(hp)^._operator in [A_CALL] then
- begin
- { with tasm call near ptr [edi+12] does not
- work but call near [edi+12] works ?? (PM)
- It works with call dword ptr [], but you
- need /m2 (2 passes) with tasm (PFV)
- }
- { if pai386(hp)^.op1t=top_ref then
- s:='near '+getopstr_jmp(pai386(hp)^.op1t,pai386(hp)^.op1)
- else
- s:='near ptr '+getopstr_jmp(pai386(hp)^.op1t,pai386(hp)^.op1);}
- s:='dword ptr '+getopstr_jmp(pai386(hp)^.op1t,pai386(hp)^.op1);
- end
- else
- begin
- s:=getopstr(pai386(hp)^.op1t,pai386(hp)^.op1,pai386(hp)^.size,pai386(hp)^._operator,false);
- if pai386(hp)^.op3t<>top_none then
- begin
- if pai386(hp)^.op2t<>top_none then
- s:=getopstr(pai386(hp)^.op2t,pointer(longint(twowords(pai386(hp)^.op2).word1)),
- pai386(hp)^.size,pai386(hp)^._operator,true)+','+s;
- s:=getopstr(pai386(hp)^.op3t,pointer(longint(twowords(pai386(hp)^.op2).word2)),
- pai386(hp)^.size,pai386(hp)^._operator,false)+','+s;
- end
- else
- if pai386(hp)^.op2t<>top_none then
- s:=getopstr(pai386(hp)^.op2t,pai386(hp)^.op2,pai386(hp)^.size,
- pai386(hp)^._operator,true)+','+s;
- end;
- s:=#9+s;
- end
- else
- begin
- { check if string instruction }
- { long form, otherwise may give range check errors }
- { in turbo pascal... }
- if ((pai386(hp)^._operator = A_CMPS) or
- (pai386(hp)^._operator = A_INS) or
- (pai386(hp)^._operator = A_OUTS) or
- (pai386(hp)^._operator = A_SCAS) or
- (pai386(hp)^._operator = A_STOS) or
- (pai386(hp)^._operator = A_MOVS) or
- (pai386(hp)^._operator = A_LODS) or
- (pai386(hp)^._operator = A_XLAT)) then
- Begin
- case pai386(hp)^.size of
- S_B: suffix:='b';
- S_W: suffix:='w';
- S_L: suffix:='d';
- else
- Message(assem_f_invalid_suffix_intel);
- end;
- end;
- s:='';
- end;
- AsmWriteLn(#9#9+prefix+int_op2str[pai386(hp)^._operator]+suffix+s);
- end;
- {$ifdef GDB}
- ait_stabn,
- ait_stabs,
- ait_stab_function_name : ;
- {$endif GDB}
- else
- internalerror(10000);
- end;
- hp:=pai(hp^.next);
- end;
- end;
- procedure ti386intasmlist.WriteAsmList;
- begin
- {$ifdef EXTDEBUG}
- if assigned(current_module^.mainsource) then
- comment(v_info,'Start writing intel-styled assembler output for '+current_module^.mainsource^);
- {$endif}
- LastSec:=sec_none;
- AsmWriteLn(#9'.386p');
- AsmWriteLn(#9'LOCALS '+target_asm.labelprefix);
- AsmWriteLn('DGROUP'#9'GROUP'#9'_BSS,_DATA');
- AsmWriteLn(#9'ASSUME'#9'CS:_CODE,ES:DGROUP,DS:DGROUP,SS:DGROUP');
- AsmLn;
- WriteTree(externals);
- { INTEL ASM doesn't support stabs
- WriteTree(debuglist);}
- WriteTree(codesegment);
- WriteTree(datasegment);
- WriteTree(consts);
- WriteTree(rttilist);
- WriteTree(bsssegment);
- AsmWriteLn(#9'END');
- AsmLn;
- {$ifdef EXTDEBUG}
- if assigned(current_module^.mainsource) then
- comment(v_info,'Done writing intel-styled assembler output for '+current_module^.mainsource^);
- {$endif EXTDEBUG}
- end;
- end.
- {
- $Log$
- Revision 1.14 1998-09-20 17:11:21 jonas
- * released REGALLOC
- Revision 1.13 1998/08/10 15:49:38 peter
- * small fixes for 0.99.5
- Revision 1.12 1998/08/08 10:19:17 florian
- * small fixes to write the extended type correct
- Revision 1.11 1998/06/05 17:46:02 peter
- * tp doesn't like comp() typecast
- Revision 1.10 1998/05/25 17:11:36 pierre
- * firstpasscount bug fixed
- now all is already set correctly the first time
- under EXTDEBUG try -gp to skip all other firstpasses
- it works !!
- * small bug fixes
- - for smallsets with -dTESTSMALLSET
- - some warnings removed (by correcting code !)
- Revision 1.9 1998/05/23 01:20:55 peter
- + aktasmmode, aktoptprocessor, aktoutputformat
- + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
- + $LIBNAME to set the library name where the unit will be put in
- * splitted cgi386 a bit (codeseg to large for bp7)
- * nasm, tasm works again. nasm moved to ag386nsm.pas
- Revision 1.8 1998/05/06 18:36:53 peter
- * tai_section extended with code,data,bss sections and enumerated type
- * ident 'compiled by FPC' moved to pmodules
- * small fix for smartlink
- Revision 1.7 1998/05/06 08:38:32 pierre
- * better position info with UseTokenInfo
- UseTokenInfo greatly simplified
- + added check for changed tree after first time firstpass
- (if we could remove all the cases were it happen
- we could skip all firstpass if firstpasscount > 1)
- Only with ExtDebug
- Revision 1.6 1998/05/04 17:54:24 peter
- + smartlinking works (only case jumptable left todo)
- * redesign of systems.pas to support assemblers and linkers
- + Unitname is now also in the PPU-file, increased version to 14
- Revision 1.5 1998/05/01 07:43:52 florian
- + basics for rtti implemented
- + switch $m (generate rtti for published sections)
- Revision 1.4 1998/04/29 10:33:41 pierre
- + added some code for ansistring (not complete nor working yet)
- * corrected operator overloading
- * corrected nasm output
- + started inline procedures
- + added starstarn : use ** for exponentiation (^ gave problems)
- + started UseTokenInfo cond to get accurate positions
- Revision 1.3 1998/04/08 16:58:01 pierre
- * several bugfixes
- ADD ADC and AND are also sign extended
- nasm output OK (program still crashes at end
- and creates wrong assembler files !!)
- procsym types sym in tdef removed !!
- Revision 1.2 1998/04/08 11:34:17 peter
- * nasm works (linux only tested)
- }
|