development/compilers/freepascal/compiler/assemble.pas

   1 {
   2     $Id$
   3     Copyright (c) 1998-2000 by Peter Vreman
   4
   5     This unit handles the assemblerfile write and assembler calls of FPC
   6
   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.
  11
  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.
  16
  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.
  20
  21  ****************************************************************************}
  22
  23 unit assemble;
  24
  25 interface
  26
  27 uses
  28 {$ifdef Delphi}
  29   dmisc,
  30 {$else Delphi}
  31   dos,
  32 {$endif Delphi}
  33   cobjects,globtype,globals,aasm;
  34
  35 const
  36 {$ifdef tp}
  37   AsmOutSize=1024;
  38 {$else}
  39   AsmOutSize=32768;
  40 {$endif}
  41
  42 type
  43   PAsmList=^TAsmList;
  44   TAsmList=object
  45   private
  46     procedure CreateSmartLinkPath(const s:string);
  47   public
  48   {filenames}
  49     path     : pathstr;
  50     name     : namestr;
  51     asmfile,         { current .s and .o file }
  52     objfile,
  53     as_bin   : string;
  54     SmartAsm : boolean;
  55     smarthcount : longint;
  56     place    : TCutPlace; { special 'end' file for import dir ? }
  57   {outfile}
  58     AsmSize,
  59     AsmStartSize,
  60     outcnt   : longint;
  61     outbuf   : array[0..AsmOutSize-1] of char;
  62     outfile  : file;
  63     Constructor Init(smart:boolean);
  64     Destructor Done;
  65     Function  FindAssembler:string;
  66     Function  CallAssembler(const command,para:string):Boolean;
  67     Function  DoAssemble:boolean;
  68     Procedure RemoveAsm;
  69     procedure NextSmartName;
  70     Procedure AsmFlush;
  71     Procedure AsmClear;
  72     Procedure AsmWrite(const s:string);
  73     Procedure AsmWritePChar(p:pchar);
  74     Procedure AsmWriteLn(const s:string);
  75     Procedure AsmLn;
  76     procedure AsmCreate(Aplace:tcutplace);
  77     procedure AsmClose;
  78     procedure Synchronize;
  79     procedure WriteTree(p:paasmoutput);virtual;
  80     procedure WriteAsmList;virtual;
  81   end;
  82
  83 var
  84   SmartLinkFilesCnt : longint;
  85
  86 Procedure GenerateAsm(smart:boolean);
  87 Procedure OnlyAsm;
  88
  89
  90 Implementation
  91
  92 uses
  93   script,files,systems,verbose
  94 {$ifdef linux}
  95   ,linux
  96 {$endif}
  97   ,strings
  98 {$ifdef i386}
  99   {$ifndef NoAg386Bin}
 100     ,ag386bin
 101   {$endif}
 102   {$ifndef NoAg386Att}
 103     ,ag386att
 104   {$endif NoAg386Att}
 105   {$ifndef NoAg386Nsm}
 106     ,ag386nsm
 107   {$endif NoAg386Nsm}
 108   {$ifndef NoAg386Int}
 109     ,ag386int
 110   {$endif NoAg386Int}
 111   {$ifdef Ag386Cof}
 112     ,ag386cof
 113   {$endif Ag386Cof}
 114 {$endif}
 115 {$ifdef m68k}
 116   {$ifndef NoAg68kGas}
 117     ,ag68kgas
 118   {$endif NoAg68kGas}
 119   {$ifndef NoAg68kMot}
 120     ,ag68kmot
 121   {$endif NoAg68kMot}
 122   {$ifndef NoAg68kMit}
 123     ,ag68kmit
 124   {$endif NoAg68kMit}
 125   {$ifndef NoAg68kMpw}
 126     ,ag68kmpw
 127   {$endif NoAg68kMpw}
 128 {$endif}
 129   ;
 130
 131
 132 {*****************************************************************************
 133                                   TAsmList
 134 *****************************************************************************}
 135
 136 Function DoPipe:boolean;
 137 begin
 138   DoPipe:=(cs_asm_pipe in aktglobalswitches) and
 139           not(cs_asm_leave in aktglobalswitches)
 140 {$ifdef i386}
 141           and (aktoutputformat=as_i386_as)
 142 {$endif i386}
 143 {$ifdef m68k}
 144           and (aktoutputformat=as_m68k_as);
 145 {$endif m68k}
 146 end;
 147
 148
 149 const
 150   lastas  : byte=255;
 151 var
 152   LastASBin : pathstr;
 153 Function TAsmList.FindAssembler:string;
 154 var
 155   asfound : boolean;
 156 begin
 157   if lastas<>ord(target_asm.id) then
 158    begin
 159      lastas:=ord(target_asm.id);
 160      { is an assembler passed ? }
 161      if utilsdirectory<>'' then
 162        LastASBin:=FindFile(target_asm.asmbin+source_os.exeext,utilsdirectory,asfound)+
 163          target_asm.asmbin+source_os.exeext;
 164      if LastASBin='' then
 165        LastASBin:=FindExe(target_asm.asmbin,asfound);
 166      if (not asfound) and not(cs_asm_extern in aktglobalswitches) then
 167       begin
 168         Message1(exec_w_assembler_not_found,LastASBin);
 169         aktglobalswitches:=aktglobalswitches+[cs_asm_extern];
 170       end;
 171      if asfound then
 172       Message1(exec_t_using_assembler,LastASBin);
 173    end;
 174   FindAssembler:=LastASBin;
 175 end;
 176
 177
 178 Function TAsmList.CallAssembler(const command,para:string):Boolean;
 179 begin
 180   callassembler:=true;
 181   if not(cs_asm_extern in aktglobalswitches) then
 182    begin
 183      swapvectors;
 184      exec(command,para);
 185      swapvectors;
 186      if (doserror<>0) then
 187       begin
 188         Message1(exec_w_cant_call_assembler,tostr(doserror));
 189         aktglobalswitches:=aktglobalswitches+[cs_asm_extern];
 190         callassembler:=false;
 191       end
 192      else
 193       if (dosexitcode<>0) then
 194        begin
 195         Message1(exec_w_error_while_assembling,tostr(dosexitcode));
 196         callassembler:=false;
 197        end;
 198    end
 199   else
 200    AsmRes.AddAsmCommand(command,para,name);
 201 end;
 202
 203
 204 procedure TAsmList.RemoveAsm;
 205 var
 206   g : file;
 207 begin
 208   if cs_asm_leave in aktglobalswitches then
 209    exit;
 210   if cs_asm_extern in aktglobalswitches then
 211    AsmRes.AddDeleteCommand(AsmFile)
 212   else
 213    begin
 214      assign(g,AsmFile);
 215      {$I-}
 216       erase(g);
 217      {$I+}
 218      if ioresult<>0 then;
 219    end;
 220 end;
 221
 222
 223 Function TAsmList.DoAssemble:boolean;
 224 var
 225   s : string;
 226 begin
 227   DoAssemble:=true;
 228   if DoPipe then
 229    exit;
 230   if not(cs_asm_extern in aktglobalswitches) then
 231    begin
 232      if SmartAsm then
 233       begin
 234         if (SmartLinkFilesCnt<=1) then
 235          Message1(exec_i_assembling_smart,name);
 236       end
 237      else
 238      Message1(exec_i_assembling,name);
 239    end;
 240   s:=target_asm.asmcmd;
 241   Replace(s,'$ASM',AsmFile);
 242   Replace(s,'$OBJ',ObjFile);
 243   if CallAssembler(FindAssembler,s) then
 244    RemoveAsm
 245   else
 246    begin
 247       DoAssemble:=false;
 248       GenerateError;
 249    end;
 250 end;
 251
 252
 253 procedure TAsmList.NextSmartName;
 254 var
 255   s : string;
 256 begin
 257   inc(SmartLinkFilesCnt);
 258   if SmartLinkFilesCnt>999999 then
 259    Message(asmw_f_too_many_asm_files);
 260   case place of
 261     cut_begin :
 262       begin
 263         inc(smarthcount);
 264         s:=current_module^.asmprefix^+tostr(smarthcount)+'h';
 265       end;
 266     cut_normal :
 267       s:=current_module^.asmprefix^+tostr(smarthcount)+'s';
 268     cut_end :
 269       s:=current_module^.asmprefix^+tostr(smarthcount)+'t';
 270   end;
 271   AsmFile:=Path+FixFileName(s+tostr(SmartLinkFilesCnt)+target_info.asmext);
 272   ObjFile:=Path+FixFileName(s+tostr(SmartLinkFilesCnt)+target_info.objext);
 273   { insert in container so it can be cleared after the linking }
 274   SmartLinkOFiles.Insert(Objfile);
 275 end;
 276
 277
 278 {*****************************************************************************
 279                        TAsmList AsmFile Writing
 280 *****************************************************************************}
 281
 282 Procedure TAsmList.AsmFlush;
 283 begin
 284   if outcnt>0 then
 285    begin
 286      BlockWrite(outfile,outbuf,outcnt);
 287      outcnt:=0;
 288    end;
 289 end;
 290
 291
 292 Procedure TAsmList.AsmClear;
 293 begin
 294   outcnt:=0;
 295 end;
 296
 297
 298 Procedure TAsmList.AsmWrite(const s:string);
 299 begin
 300   if OutCnt+length(s)>=AsmOutSize then
 301    AsmFlush;
 302   Move(s[1],OutBuf[OutCnt],length(s));
 303   inc(OutCnt,length(s));
 304   inc(AsmSize,length(s));
 305 end;
 306
 307
 308 Procedure TAsmList.AsmWriteLn(const s:string);
 309 begin
 310   AsmWrite(s);
 311   AsmLn;
 312 end;
 313
 314
 315 Procedure TAsmList.AsmWritePChar(p:pchar);
 316 var
 317   i,j : longint;
 318 begin
 319   i:=StrLen(p);
 320   j:=i;
 321   while j>0 do
 322    begin
 323      i:=min(j,AsmOutSize);
 324      if OutCnt+i>=AsmOutSize then
 325       AsmFlush;
 326      Move(p[0],OutBuf[OutCnt],i);
 327      inc(OutCnt,i);
 328      inc(AsmSize,i);
 329      dec(j,i);
 330      p:=pchar(@p[i]);
 331    end;
 332 end;
 333
 334
 335 Procedure TAsmList.AsmLn;
 336 begin
 337   if OutCnt>=AsmOutSize-2 then
 338    AsmFlush;
 339   OutBuf[OutCnt]:=target_os.newline[1];
 340   inc(OutCnt);
 341   inc(AsmSize);
 342   if length(target_os.newline)>1 then
 343    begin
 344      OutBuf[OutCnt]:=target_os.newline[2];
 345      inc(OutCnt);
 346      inc(AsmSize);
 347    end;
 348 end;
 349
 350
 351 procedure TAsmList.AsmCreate(Aplace:tcutplace);
 352 begin
 353   place:=Aplace;
 354   if SmartAsm then
 355    NextSmartName;
 356 {$ifdef linux}
 357   if DoPipe then
 358    begin
 359      Message1(exec_i_assembling_pipe,asmfile);
 360      POpen(outfile,'as -o '+objfile,'W');
 361    end
 362   else
 363 {$endif}
 364    begin
 365      Assign(outfile,asmfile);
 366      {$I-}
 367       Rewrite(outfile,1);
 368      {$I+}
 369      if ioresult<>0 then
 370       Message1(exec_d_cant_create_asmfile,asmfile);
 371    end;
 372   outcnt:=0;
 373   AsmSize:=0;
 374   AsmStartSize:=0;
 375 end;
 376
 377
 378 procedure TAsmList.AsmClose;
 379 var
 380   f : file;
 381   l : longint;
 382 begin
 383   AsmFlush;
 384 {$ifdef linux}
 385   if DoPipe then
 386    Close(outfile)
 387   else
 388 {$endif}
 389    begin
 390    {Touch Assembler time to ppu time is there is a ppufilename}
 391      if Assigned(current_module^.ppufilename) then
 392       begin
 393         Assign(f,current_module^.ppufilename^);
 394         {$I-}
 395          reset(f,1);
 396         {$I+}
 397         if ioresult=0 then
 398          begin
 399            getftime(f,l);
 400            close(f);
 401            reset(outfile,1);
 402            setftime(outfile,l);
 403          end;
 404       end;
 405      close(outfile);
 406    end;
 407 end;
 408
 409
 410 {Touch Assembler and object time to ppu time is there is a ppufilename}
 411 procedure TAsmList.Synchronize;
 412 begin
 413 {Touch Assembler time to ppu time is there is a ppufilename}
 414   if Assigned(current_module^.ppufilename) then
 415    begin
 416      SynchronizeFileTime(current_module^.ppufilename^,asmfile);
 417      if not(cs_asm_extern in aktglobalswitches) then
 418        SynchronizeFileTime(current_module^.ppufilename^,objfile);
 419    end;
 420 end;
 421
 422
 423 procedure TAsmList.WriteTree(p:paasmoutput);
 424 begin
 425 end;
 426
 427
 428 procedure TAsmList.WriteAsmList;
 429 begin
 430 end;
 431
 432
 433 procedure TAsmList.CreateSmartLinkPath(const s:string);
 434 var
 435   dir : searchrec;
 436 begin
 437   if PathExists(s) then
 438    begin
 439      { the path exists, now we clean only all the .o and .s files }
 440      { .o files }
 441      findfirst(s+dirsep+'*'+target_info.objext,anyfile,dir);
 442      while (doserror=0) do
 443       begin
 444         RemoveFile(s+dirsep+dir.name);
 445         findnext(dir);
 446       end;
 447 {$ifdef fpc}
 448      findclose(dir);
 449 {$endif}
 450      { .s files }
 451      findfirst(s+dirsep+'*'+target_info.asmext,anyfile,dir);
 452      while (doserror=0) do
 453       begin
 454         RemoveFile(s+dirsep+dir.name);
 455         findnext(dir);
 456       end;
 457 {$ifdef fpc}
 458      findclose(dir);
 459 {$endif}
 460    end
 461   else
 462    begin
 463      {$I-}
 464       mkdir(s);
 465      {$I+}
 466      if ioresult<>0 then;
 467    end;
 468 end;
 469
 470
 471 Constructor TAsmList.Init(smart:boolean);
 472 begin
 473 { load start values }
 474   asmfile:=current_module^.asmfilename^;
 475   objfile:=current_module^.objfilename^;
 476   name:=FixFileName(current_module^.modulename^);
 477   OutCnt:=0;
 478   SmartLinkFilesCnt:=0;
 479   SmartLinkOFiles.Clear;
 480   place:=cut_normal;
 481   SmartAsm:=smart;
 482   SmartHCount:=0;
 483 { Which path will be used ? }
 484   if SmartAsm then
 485    begin
 486      path:=current_module^.outputpath^+FixFileName(current_module^.modulename^)+target_info.smartext;
 487      CreateSmartLinkPath(path);
 488      path:=FixPath(path,false);
 489    end
 490   else
 491    path:=current_module^.outputpath^;
 492 end;
 493
 494
 495 Destructor TAsmList.Done;
 496 begin
 497 end;
 498
 499
 500 {*****************************************************************************
 501                      Generate Assembler Files Main Procedure
 502 *****************************************************************************}
 503
 504 Procedure GenerateAsm(smart:boolean);
 505 var
 506   a : PAsmList;
 507 {$ifdef i386}
 508   {$ifndef NoAg386Bin}
 509     b : Pi386binasmlist;
 510   {$endif}
 511 {$endif}
 512 begin
 513   case aktoutputformat of
 514      as_none : ;
 515 {$ifdef i386}
 516   {$ifndef NoAg386Bin}
 517      as_i386_dbg,
 518      as_i386_coff,
 519      as_i386_pecoff :
 520        begin
 521          case aktoutputformat of
 522            as_i386_dbg :
 523              b:=new(pi386binasmlist,Init(og_dbg,smart));
 524            as_i386_coff :
 525              b:=new(pi386binasmlist,Init(og_coff,smart));
 526            as_i386_pecoff :
 527              b:=new(pi386binasmlist,Init(og_pecoff,smart));
 528          end;
 529          b^.WriteBin;
 530          dispose(b,done);
 531          if assigned(current_module^.ppufilename) then
 532           begin
 533             if smart then
 534               SynchronizeFileTime(current_module^.ppufilename^,current_module^.staticlibfilename^)
 535             else
 536               SynchronizeFileTime(current_module^.ppufilename^,current_module^.objfilename^);
 537           end;
 538          exit;
 539        end;
 540   {$endif NoAg386Bin}
 541   {$ifndef NoAg386Att}
 542      as_i386_as,
 543      as_i386_as_aout,
 544      as_i386_asw :
 545        a:=new(pi386attasmlist,Init(smart));
 546   {$endif NoAg386Att}
 547   {$ifndef NoAg386Nsm}
 548      as_i386_nasmcoff,
 549      as_i386_nasmwin32,
 550      as_i386_nasmelf,
 551      as_i386_nasmobj :
 552        a:=new(pi386nasmasmlist,Init(smart));
 553   {$endif NoAg386Nsm}
 554   {$ifndef NoAg386Int}
 555      as_i386_tasm :
 556        a:=new(pi386intasmlist,Init(smart));
 557   {$endif NoAg386Int}
 558 {$endif}
 559 {$ifdef m68k}
 560   {$ifndef NoAg68kGas}
 561      as_m68k_as,
 562      as_m68k_gas :
 563        a:=new(pm68kgasasmlist,Init(smart));
 564   {$endif NoAg86KGas}
 565   {$ifndef NoAg68kMot}
 566      as_m68k_mot :
 567        a:=new(pm68kmotasmlist,Init(smart));
 568   {$endif NoAg86kMot}
 569   {$ifndef NoAg68kMit}
 570      as_m68k_mit :
 571        a:=new(pm68kmitasmlist,Init(smart));
 572   {$endif NoAg86KMot}
 573   {$ifndef NoAg68kMpw}
 574      as_m68k_mpw :
 575        a:=new(pm68kmpwasmlist,Init(smart));
 576   {$endif NoAg68kMpw}
 577 {$endif}
 578   else
 579 {$ifdef TP}
 580     exit;
 581 {$else}
 582     Message(asmw_f_assembler_output_not_supported);
 583 {$endif}
 584   end;
 585   a^.AsmCreate(cut_normal);
 586   a^.WriteAsmList;
 587   a^.AsmClose;
 588   a^.DoAssemble;
 589   a^.synchronize;
 590   dispose(a,Done);
 591 end;
 592
 593
 594 Procedure OnlyAsm;
 595 var
 596   a : PAsmList;
 597 begin
 598   a:=new(pasmlist,Init(false));
 599   a^.DoAssemble;
 600   dispose(a,Done);
 601 end;
 602
 603 end.
 604 {
 605   $Log$
 606   Revision 1.1  2002/02/19 08:21:28  sasu
 607   Initial revision
 608
 609   Revision 1.1  2000/07/13 06:29:44  michael
 610   + Initial import
 611
 612   Revision 1.65  2000/06/01 19:11:19  peter
 613     * added ifdef fpc around findclose
 614
 615   Revision 1.64  2000/06/01 13:02:45  peter
 616     * clean .o and .s from smartlinkpath when starting the writer
 617
 618   Revision 1.63  2000/04/04 15:05:03  pierre
 619    + accept nasmwin32 output
 620
 621   Revision 1.62  2000/02/24 18:41:38  peter
 622     * removed warnings/notes
 623
 624   Revision 1.61  2000/02/09 13:22:45  peter
 625     * log truncated
 626
 627   Revision 1.60  2000/01/11 09:52:06  peter
 628     * fixed placing of .sl directories
 629     * use -b again for base-file selection
 630     * fixed group writing for linux with smartlinking
 631
 632   Revision 1.59  2000/01/07 01:14:19  peter
 633     * updated copyright to 2000
 634
 635   Revision 1.58  1999/11/12 11:03:49  peter
 636     * searchpaths changed to stringqueue object
 637
 638   Revision 1.57  1999/11/08 10:37:12  peter
 639     * filename fixes for win32 imports for units with multiple needed dll's
 640
 641   Revision 1.56  1999/11/06 14:34:17  peter
 642     * truncated log to 20 revs
 643
 644   Revision 1.55  1999/11/02 15:06:57  peter
 645     * import library fixes for win32
 646     * alignment works again
 647
 648   Revision 1.54  1999/09/16 11:34:44  pierre
 649    * typo correction
 650
 651   Revision 1.53  1999/09/02 18:47:44  daniel
 652     * Could not compile with TP, some arrays moved to heap
 653     * NOAG386BIN default for TP
 654     * AG386* files were not compatible with TP, fixed.
 655
 656 }