| blob | 59cd510e383b383f30a37b95699a48aaf628c6e6 |
1 {
2 $Id$
3 Copyright (c) 1998-2000 by Florian Klaempfl
5 This unit implements an asmoutput class for Intel syntax with Intel i386+
7 This program is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2 of the License, or
10 (at your option) any later version.
12 This program is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
17 You should have received a copy of the GNU General Public License
18 along with this program; if not, write to the Free Software
19 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
21 ****************************************************************************
22 }
23 {$ifdef TP}
24 {$N+,E+}
25 {$endif}
26 unit ag386int;
28 interface
30 uses aasm,assemble;
32 type
33 pi386intasmlist=^ti386intasmlist;
34 ti386intasmlist = object(tasmlist)
35 procedure WriteTree(p:paasmoutput);virtual;
36 procedure WriteAsmList;virtual;
37 procedure WriteExternals;
38 end;
40 implementation
42 uses
43 strings,
44 globtype,globals,systems,cobjects,
45 files,verbose,cpubase,cpuasm
46 {$ifdef GDB}
47 ,gdb
48 {$endif GDB}
49 ;
51 const
52 line_length = 70;
54 {$ifdef EXTTYPE}
55 extstr : array[EXT_NEAR..EXT_ABS] of String[8] =
56 ('NEAR','FAR','PROC','BYTE','WORD','DWORD',
57 'CODEPTR','DATAPTR','FWORD','PWORD','QWORD','TBYTE','ABS');
58 {$endif}
60 function single2str(d : single) : string;
61 var
62 hs : string;
63 p : byte;
64 begin
65 str(d,hs);
66 { nasm expects a lowercase e }
67 p:=pos('E',hs);
68 if p>0 then
69 hs[p]:='e';
70 p:=pos('+',hs);
71 if p>0 then
72 delete(hs,p,1);
73 single2str:=lower(hs);
74 end;
76 function double2str(d : double) : string;
77 var
78 hs : string;
79 p : byte;
80 begin
81 str(d,hs);
82 { nasm expects a lowercase e }
83 p:=pos('E',hs);
84 if p>0 then
85 hs[p]:='e';
86 p:=pos('+',hs);
87 if p>0 then
88 delete(hs,p,1);
89 double2str:=lower(hs);
90 end;
92 function extended2str(e : extended) : string;
93 var
94 hs : string;
95 p : byte;
96 begin
97 str(e,hs);
98 { nasm expects a lowercase e }
99 p:=pos('E',hs);
100 if p>0 then
101 hs[p]:='e';
102 p:=pos('+',hs);
103 if p>0 then
104 delete(hs,p,1);
105 extended2str:=lower(hs);
106 end;
109 function comp2str(d : bestreal) : string;
110 type
111 pdouble = ^double;
112 var
113 c : comp;
114 dd : pdouble;
115 begin
116 {$ifdef FPC}
117 c:=comp(d);
118 {$else}
119 c:=d;
120 {$endif}
121 dd:=pdouble(@c); { this makes a bitwise copy of c into a double }
122 comp2str:=double2str(dd^);
123 end;
125 function getreferencestring(var ref : treference) : string;
126 var
127 s : string;
128 first : boolean;
129 begin
130 if ref.is_immediate then
131 begin
132 getreferencestring:=tostr(ref.offset);
133 exit;
134 end
135 else
136 with ref do
137 begin
138 first:=true;
139 inc(offset,offsetfixup);
140 offsetfixup:=0;
141 if ref.segment<>R_NO then
142 s:=int_reg2str[segment]+':['
143 else
144 s:='[';
145 if assigned(symbol) then
146 begin
147 s:=s+symbol^.name;
148 first:=false;
149 end;
150 if (base<>R_NO) then
151 begin
152 if not(first) then
153 s:=s+'+'
154 else
155 first:=false;
156 s:=s+int_reg2str[base];
157 end;
158 if (index<>R_NO) then
159 begin
160 if not(first) then
161 s:=s+'+'
162 else
163 first:=false;
164 s:=s+int_reg2str[index];
165 if scalefactor<>0 then
166 s:=s+'*'+tostr(scalefactor);
167 end;
168 if offset<0 then
169 s:=s+tostr(offset)
170 else if (offset>0) then
171 s:=s+'+'+tostr(offset);
172 s:=s+']';
173 end;
174 getreferencestring:=s;
175 end;
178 function getopstr(const o:toper;s : topsize; opcode: tasmop;dest : boolean) : string;
179 var
180 hs : string;
181 begin
182 case o.typ of
183 top_reg :
184 getopstr:=int_reg2str[o.reg];
185 top_const :
186 getopstr:=tostr(o.val);
187 top_symbol :
188 begin
189 if assigned(o.sym) then
190 hs:='offset '+o.sym^.name
191 else
192 hs:='offset ';
193 if o.symofs>0 then
194 hs:=hs+'+'+tostr(o.symofs)
195 else
196 if o.symofs<0 then
197 hs:=hs+tostr(o.symofs)
198 else
199 if not(assigned(o.sym)) then
200 hs:=hs+'0';
201 getopstr:=hs;
202 end;
203 top_ref :
204 begin
205 hs:=getreferencestring(o.ref^);
206 if ((opcode <> A_LGS) and (opcode <> A_LSS) and
207 (opcode <> A_LFS) and (opcode <> A_LDS) and
208 (opcode <> A_LES)) then
209 Begin
210 case s of
211 S_B : hs:='byte ptr '+hs;
212 S_W : hs:='word ptr '+hs;
213 S_L : hs:='dword ptr '+hs;
214 S_IS : hs:='word ptr '+hs;
215 S_IL : hs:='dword ptr '+hs;
216 S_IQ : hs:='qword ptr '+hs;
217 S_FS : hs:='dword ptr '+hs;
218 S_FL : hs:='qword ptr '+hs;
219 S_FX : hs:='tbyte ptr '+hs;
220 S_BW : if dest then
221 hs:='word ptr '+hs
222 else
223 hs:='byte ptr '+hs;
224 S_BL : if dest then
225 hs:='dword ptr '+hs
226 else
227 hs:='byte ptr '+hs;
228 S_WL : if dest then
229 hs:='dword ptr '+hs
230 else
231 hs:='word ptr '+hs;
232 end;
233 end;
234 getopstr:=hs;
235 end;
236 else
237 internalerror(10001);
238 end;
239 end;
241 function getopstr_jmp(const o:toper) : string;
242 var
243 hs : string;
244 begin
245 case o.typ of
246 top_reg :
247 getopstr_jmp:=int_reg2str[o.reg];
248 top_const :
249 getopstr_jmp:=tostr(o.val);
250 top_symbol :
251 begin
252 hs:=o.sym^.name;
253 if o.symofs>0 then
254 hs:=hs+'+'+tostr(o.symofs)
255 else
256 if o.symofs<0 then
257 hs:=hs+tostr(o.symofs);
258 getopstr_jmp:=hs;
259 end;
260 top_ref :
261 getopstr_jmp:=getreferencestring(o.ref^);
262 else
263 internalerror(10001);
264 end;
265 end;
268 {****************************************************************************
269 TI386INTASMLIST
270 ****************************************************************************}
272 var
273 LastSec : tsection;
275 const
276 ait_const2str:array[ait_const_32bit..ait_const_8bit] of string[8]=
277 (#9'DD'#9,#9'DW'#9,#9'DB'#9);
279 Function PadTabs(const p:string;addch:char):string;
280 var
281 s : string;
282 i : longint;
283 begin
284 i:=length(p);
285 if addch<>#0 then
286 begin
287 inc(i);
288 s:=p+addch;
289 end
290 else
291 s:=p;
292 if i<8 then
293 PadTabs:=s+#9#9
294 else
295 PadTabs:=s+#9;
296 end;
298 procedure ti386intasmlist.WriteTree(p:paasmoutput);
299 const
300 allocstr : array[boolean] of string[10]=(' released',' allocated');
301 var
302 s,
303 prefix,
304 suffix : string;
305 hp : pai;
306 counter,
307 lines,
308 i,j,l : longint;
309 consttyp : tait;
310 found,
311 quoted : boolean;
312 sep : char;
313 begin
314 if not assigned(p) then
315 exit;
316 hp:=pai(p^.first);
317 while assigned(hp) do
318 begin
319 case hp^.typ of
320 ait_comment : Begin
321 AsmWrite(target_asm.comment);
322 AsmWritePChar(pai_asm_comment(hp)^.str);
323 AsmLn;
324 End;
325 ait_regalloc,
326 ait_tempalloc : ;
327 ait_section : begin
328 if LastSec<>sec_none then
329 AsmWriteLn('_'+target_asm.secnames[LastSec]+#9#9'ENDS');
330 if pai_section(hp)^.sec<>sec_none then
331 begin
332 AsmLn;
333 AsmWriteLn('_'+target_asm.secnames[pai_section(hp)^.sec]+#9#9+
334 'SEGMENT'#9'PARA PUBLIC USE32 '''+
335 target_asm.secnames[pai_section(hp)^.sec]+'''');
336 end;
337 LastSec:=pai_section(hp)^.sec;
338 end;
339 ait_align : begin
340 { CAUSES PROBLEMS WITH THE SEGMENT DEFINITION }
341 { SEGMENT DEFINITION SHOULD MATCH TYPE OF ALIGN }
342 { HERE UNDER TASM! }
343 AsmWriteLn(#9'ALIGN '+tostr(pai_align(hp)^.aligntype));
344 end;
345 ait_datablock : begin
346 if pai_datablock(hp)^.is_global then
347 AsmWriteLn(#9'PUBLIC'#9+pai_datablock(hp)^.sym^.name);
348 AsmWriteLn(PadTabs(pai_datablock(hp)^.sym^.name,#0)+'DB'#9+tostr(pai_datablock(hp)^.size)+' DUP(?)');
349 end;
350 ait_const_32bit,
351 ait_const_8bit,
352 ait_const_16bit : begin
353 AsmWrite(ait_const2str[hp^.typ]+tostr(pai_const(hp)^.value));
354 consttyp:=hp^.typ;
355 l:=0;
356 repeat
357 found:=(not (Pai(hp^.next)=nil)) and (Pai(hp^.next)^.typ=consttyp);
358 if found then
359 begin
360 hp:=Pai(hp^.next);
361 s:=','+tostr(pai_const(hp)^.value);
362 AsmWrite(s);
363 inc(l,length(s));
364 end;
365 until (not found) or (l>line_length);
366 AsmLn;
367 end;
368 ait_const_symbol : begin
369 AsmWriteLn(#9#9'DD'#9'offset '+pai_const_symbol(hp)^.sym^.name);
370 if pai_const_symbol(hp)^.offset>0 then
371 AsmWrite('+'+tostr(pai_const_symbol(hp)^.offset))
372 else if pai_const_symbol(hp)^.offset<0 then
373 AsmWrite(tostr(pai_const_symbol(hp)^.offset));
374 AsmLn;
375 end;
376 ait_const_rva : begin
377 AsmWriteLn(#9#9'RVA'#9+pai_const_symbol(hp)^.sym^.name);
378 end;
379 ait_real_32bit : AsmWriteLn(#9#9'DD'#9+single2str(pai_real_32bit(hp)^.value));
380 ait_real_64bit : AsmWriteLn(#9#9'DQ'#9+double2str(pai_real_64bit(hp)^.value));
381 ait_real_80bit : AsmWriteLn(#9#9'DT'#9+extended2str(pai_real_80bit(hp)^.value));
382 ait_comp_64bit : AsmWriteLn(#9#9'DQ'#9+comp2str(pai_real_80bit(hp)^.value));
383 ait_string : begin
384 counter := 0;
385 lines := pai_string(hp)^.len div line_length;
386 { separate lines in different parts }
387 if pai_string(hp)^.len > 0 then
388 Begin
389 for j := 0 to lines-1 do
390 begin
391 AsmWrite(#9#9'DB'#9);
392 quoted:=false;
393 for i:=counter to counter+line_length do
394 begin
395 { it is an ascii character. }
396 if (ord(pai_string(hp)^.str[i])>31) and
397 (ord(pai_string(hp)^.str[i])<128) and
398 (pai_string(hp)^.str[i]<>'"') then
399 begin
400 if not(quoted) then
401 begin
402 if i>counter then
403 AsmWrite(',');
404 AsmWrite('"');
405 end;
406 AsmWrite(pai_string(hp)^.str[i]);
407 quoted:=true;
408 end { if > 31 and < 128 and ord('"') }
409 else
410 begin
411 if quoted then
412 AsmWrite('"');
413 if i>counter then
414 AsmWrite(',');
415 quoted:=false;
416 AsmWrite(tostr(ord(pai_string(hp)^.str[i])));
417 end;
418 end; { end for i:=0 to... }
419 if quoted then AsmWrite('"');
420 AsmWrite(target_os.newline);
421 counter := counter+line_length;
422 end; { end for j:=0 ... }
423 { do last line of lines }
424 AsmWrite(#9#9'DB'#9);
425 quoted:=false;
426 for i:=counter to pai_string(hp)^.len-1 do
427 begin
428 { it is an ascii character. }
429 if (ord(pai_string(hp)^.str[i])>31) and
430 (ord(pai_string(hp)^.str[i])<128) and
431 (pai_string(hp)^.str[i]<>'"') then
432 begin
433 if not(quoted) then
434 begin
435 if i>counter then
436 AsmWrite(',');
437 AsmWrite('"');
438 end;
439 AsmWrite(pai_string(hp)^.str[i]);
440 quoted:=true;
441 end { if > 31 and < 128 and " }
442 else
443 begin
444 if quoted then
445 AsmWrite('"');
446 if i>counter then
447 AsmWrite(',');
448 quoted:=false;
449 AsmWrite(tostr(ord(pai_string(hp)^.str[i])));
450 end;
451 end; { end for i:=0 to... }
452 if quoted then
453 AsmWrite('"');
454 end;
455 AsmLn;
456 end;
457 ait_label : begin
458 if pai_label(hp)^.l^.is_used then
459 begin
460 AsmWrite(pai_label(hp)^.l^.name);
461 if assigned(hp^.next) and not(pai(hp^.next)^.typ in
462 [ait_const_32bit,ait_const_16bit,ait_const_8bit,
463 ait_const_symbol,ait_const_rva,
464 ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_string]) then
465 AsmWriteLn(':');
466 end;
467 end;
468 ait_direct : begin
469 AsmWritePChar(pai_direct(hp)^.str);
470 AsmLn;
471 end;
472 ait_symbol : begin
473 if pai_symbol(hp)^.is_global then
474 AsmWriteLn(#9'PUBLIC'#9+pai_symbol(hp)^.sym^.name);
475 AsmWrite(pai_symbol(hp)^.sym^.name);
476 if assigned(hp^.next) and not(pai(hp^.next)^.typ in
477 [ait_const_32bit,ait_const_16bit,ait_const_8bit,
478 ait_const_symbol,ait_const_rva,
479 ait_real_32bit,ait_real_64bit,ait_real_80bit,ait_comp_64bit,ait_string]) then
480 AsmWriteLn(':')
481 end;
482 ait_symbol_end : begin
483 end;
484 ait_instruction : begin
485 { Must be done with args in ATT order }
486 paicpu(hp)^.CheckNonCommutativeOpcodes;
487 { We need intel order, no At&t }
488 paicpu(hp)^.SwapOperands;
489 { Reset }
490 suffix:='';
491 prefix:= '';
492 s:='';
493 { We need to explicitely set
494 word prefix to get selectors
495 to be pushed in 2 bytes PM }
496 if (paicpu(hp)^.opsize=S_W) and
497 ((paicpu(hp)^.opcode=A_PUSH) or
498 (paicpu(hp)^.opcode=A_POP)) and
499 (paicpu(hp)^.oper[0].typ=top_reg) and
500 ((paicpu(hp)^.oper[0].reg>=firstsreg) and
501 (paicpu(hp)^.oper[0].reg<=lastsreg)) then
502 AsmWriteln(#9#9'DB'#9'066h');
503 { added prefix instructions, must be on same line as opcode }
504 if (paicpu(hp)^.ops = 0) and
505 ((paicpu(hp)^.opcode = A_REP) or
506 (paicpu(hp)^.opcode = A_LOCK) or
507 (paicpu(hp)^.opcode = A_REPE) or
508 (paicpu(hp)^.opcode = A_REPNZ) or
509 (paicpu(hp)^.opcode = A_REPZ) or
510 (paicpu(hp)^.opcode = A_REPNE)) then
511 Begin
512 prefix:=int_op2str[paicpu(hp)^.opcode]+#9;
513 hp:=Pai(hp^.next);
514 { this is theorically impossible... }
515 if hp=nil then
516 begin
517 s:=#9#9+prefix;
518 AsmWriteLn(s);
519 break;
520 end;
521 { nasm prefers prefix on a line alone }
522 AsmWriteln(#9#9+prefix);
523 prefix:='';
524 end
525 else
526 prefix:= '';
527 if paicpu(hp)^.ops<>0 then
528 begin
529 if is_calljmp(paicpu(hp)^.opcode) then
530 s:=#9+getopstr_jmp(paicpu(hp)^.oper[0])
531 else
532 begin
533 for i:=0to paicpu(hp)^.ops-1 do
534 begin
535 if i=0 then
536 sep:=#9
537 else
538 sep:=',';
539 s:=s+sep+getopstr(paicpu(hp)^.oper[i],paicpu(hp)^.opsize,paicpu(hp)^.opcode,(i=2));
540 end;
541 end;
542 end;
543 AsmWriteLn(#9#9+prefix+int_op2str[paicpu(hp)^.opcode]+cond2str[paicpu(hp)^.condition]+suffix+s);
544 end;
545 {$ifdef GDB}
546 ait_stabn,
547 ait_stabs,
548 ait_force_line,
549 ait_stab_function_name : ;
550 {$endif GDB}
551 ait_cut : begin
552 { only reset buffer if nothing has changed }
553 if AsmSize=AsmStartSize then
554 AsmClear
555 else
556 begin
557 if LastSec<>sec_none then
558 AsmWriteLn('_'+target_asm.secnames[LastSec]+#9#9'ENDS');
559 AsmLn;
560 AsmWriteLn(#9'END');
561 AsmClose;
562 DoAssemble;
563 AsmCreate(pai_cut(hp)^.place);
564 end;
565 { avoid empty files }
566 while assigned(hp^.next) and (pai(hp^.next)^.typ in [ait_cut,ait_section,ait_comment]) do
567 begin
568 if pai(hp^.next)^.typ=ait_section then
569 begin
570 lastsec:=pai_section(hp^.next)^.sec;
571 end;
572 hp:=pai(hp^.next);
573 end;
574 AsmWriteLn(#9'.386p');
575 { I was told that this isn't necesarry because }
576 { the labels generated by FPC are unique (FK) }
577 { AsmWriteLn(#9'LOCALS '+target_asm.labelprefix); }
578 if lastsec<>sec_none then
579 AsmWriteLn('_'+target_asm.secnames[lastsec]+#9#9+
580 'SEGMENT'#9'PARA PUBLIC USE32 '''+
581 target_asm.secnames[lastsec]+'''');
582 AsmStartSize:=AsmSize;
583 end;
584 ait_marker: ;
585 else
586 internalerror(10000);
587 end;
588 hp:=pai(hp^.next);
589 end;
590 end;
592 var
593 currentasmlist : PAsmList;
595 procedure writeexternal(p:pnamedindexobject);{$ifndef FPC}far;{$endif}
596 begin
597 if pasmsymbol(p)^.deftyp=AS_EXTERNAL then
598 currentasmlist^.AsmWriteln(#9'EXTRN'#9+p^.name);
599 end;
601 procedure ti386intasmlist.WriteExternals;
602 begin
603 currentasmlist:=@self;
604 AsmSymbolList^.foreach({$ifndef VER70}@{$endif}writeexternal);
605 end;
608 procedure ti386intasmlist.WriteAsmList;
609 begin
610 {$ifdef EXTDEBUG}
611 if assigned(current_module^.mainsource) then
612 comment(v_info,'Start writing intel-styled assembler output for '+current_module^.mainsource^);
613 {$endif}
614 LastSec:=sec_none;
615 AsmWriteLn(#9'.386p');
616 AsmWriteLn(#9'LOCALS '+target_asm.labelprefix);
617 AsmWriteLn('DGROUP'#9'GROUP'#9'_BSS,_DATA');
618 AsmWriteLn(#9'ASSUME'#9'CS:_CODE,ES:DGROUP,DS:DGROUP,SS:DGROUP');
619 AsmLn;
621 countlabelref:=false;
623 WriteExternals;
625 { INTEL ASM doesn't support stabs
626 WriteTree(debuglist);}
628 WriteTree(codesegment);
629 WriteTree(datasegment);
630 WriteTree(consts);
631 WriteTree(rttilist);
632 WriteTree(resourcestringlist);
633 WriteTree(bsssegment);
634 countlabelref:=true;
636 AsmWriteLn(#9'END');
637 AsmLn;
639 {$ifdef EXTDEBUG}
640 if assigned(current_module^.mainsource) then
641 comment(v_info,'Done writing intel-styled assembler output for '+current_module^.mainsource^);
642 {$endif EXTDEBUG}
643 end;
645 end.
646 {
647 $Log$
648 Revision 1.1 2002/02/19 08:21:25 sasu
649 Initial revision
651 Revision 1.1.2.1 2000/08/20 17:37:11 peter
652 * smartlinking fixed for linux
654 Revision 1.1 2000/07/13 06:29:43 michael
655 + Initial import
657 Revision 1.62 2000/05/12 21:26:22 pierre
658 * fix the FDIV FDIVR FSUB FSUBR and popping equivalent
659 simply by swapping from reverse to normal and vice-versa
660 when passing from one syntax to the other !
662 Revision 1.61 2000/05/09 21:44:27 pierre
663 * add .byte 066h to force correct pushw %es
664 * handle push es as a pushl %es
666 Revision 1.60 2000/04/06 07:05:57 pierre
667 * handle offsetfixup
669 Revision 1.59 2000/02/09 13:22:43 peter
670 * log truncated
672 Revision 1.58 2000/01/07 01:14:18 peter
673 * updated copyright to 2000
675 Revision 1.57 1999/12/19 17:36:25 florian
676 * generation of LOCALS @@ removed
678 Revision 1.56 1999/11/06 14:34:16 peter
679 * truncated log to 20 revs
681 Revision 1.55 1999/11/02 15:06:56 peter
682 * import library fixes for win32
683 * alignment works again
685 Revision 1.54 1999/09/10 15:41:18 peter
686 * added symbol_end
688 Revision 1.53 1999/09/02 18:47:42 daniel
689 * Could not compile with TP, some arrays moved to heap
690 * NOAG386BIN default for TP
691 * AG386* files were not compatible with TP, fixed.
693 Revision 1.52 1999/08/25 11:59:36 jonas
694 * changed pai386, paippc and paiapha (same for tai*) to paicpu (taicpu)
696 Revision 1.51 1999/08/04 00:22:36 florian
697 * renamed i386asm and i386base to cpuasm and cpubase
699 Revision 1.50 1999/07/22 09:37:31 florian
700 + resourcestring implemented
701 + start of longstring support
703 }