home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 2 / AACD 2.iso / AACD / Programming / fpc / compiler / assemble.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-09-24  |  11.7 KB  |  503 lines
  1. {
  2.     $Id: assemble.pas,v 1.1.1.1.2.2 1998/08/13 13:33:16 carl Exp $
  3.     Copyright (c) 1998 by the FPC development team
  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.   dos,cobjects,globals,aasm;
  29.  
  30. const
  31. {$ifdef tp}
  32.   AsmOutSize=1024;
  33. {$else}
  34.   AsmOutSize=10000;
  35. {$endif}
  36.  
  37.  
  38. {$ifdef i386}
  39. { tof = (of_none,of_o,of_obj,of_masm,of_att,of_nasm,of_win32) }
  40.   AsBin : array[tof] of string[8]=('','as','nasm','masm','as','nasm','asw');
  41. {$endif}
  42. {$ifdef m68k}
  43. { tof = (of_none,of_o,of_gas,of_mot,of_mit) }
  44.   AsBin : array[tof] of string[8]=('','amigaas','amigaas','','amigaas');
  45. {$endif}
  46.  
  47.  
  48. type
  49.   PAsmList=^TAsmList;
  50.   TAsmList=object
  51.     outcnt  : longint;
  52.     outbuf  : array[0..AsmOutSize-1] of char;
  53.     outfile : file;
  54.     constructor Init;
  55.     destructor Done;
  56.     Procedure AsmFlush;
  57.     Procedure AsmWrite(const s:string);
  58.     Procedure AsmWritePChar(p:pchar);
  59.     Procedure AsmWriteLn(const s:string);
  60.     Procedure AsmLn;
  61.     procedure OpenAsmList(const fn,fn2:string);
  62.     procedure CloseAsmList;
  63.     procedure WriteTree(p:paasmoutput);virtual;
  64.     procedure WriteAsmList;virtual;
  65.   end;
  66.  
  67.   PAsmFile=^TAsmFile;
  68.   TAsmFile=object
  69.     asmlist : pasmlist;
  70.     path:dirstr;
  71.     asmfile,
  72.     objfile,
  73.     srcfile,
  74.     as_bin  : string;
  75.     Constructor Init(const fn:string);
  76.     Destructor Done;
  77.     Function FindAssembler(curr_of:tof):string;
  78.     Procedure WriteAsmSource;
  79.     Function CallAssembler(const command,para:string):Boolean;
  80.     Procedure RemoveAsm;
  81.     Function DoAssemble:boolean;
  82.   end;
  83.  
  84. Implementation
  85.  
  86. uses
  87.   script,files,systems,verbose
  88. {$ifdef linux}
  89.   ,linux
  90. {$endif}
  91.   ,strings
  92. {$ifdef i386}
  93.   ,ag386att,ag386int
  94. {$endif}
  95. {$ifdef m68k}
  96.   ,ag68kmot,ag68kgas,ag68kmit
  97. {$endif}
  98.   ;
  99.  
  100.  
  101. Function DoPipe:boolean;
  102. begin
  103.   DoPipe:=use_pipe and (not writeasmfile) and (current_module^.output_format=of_o);
  104. end;
  105.  
  106.  
  107. {*****************************************************************************
  108.                                   TASMLIST
  109. *****************************************************************************}
  110.  
  111. Procedure TAsmList.AsmFlush;
  112. begin
  113.   if outcnt>0 then
  114.    begin
  115.      BlockWrite(outfile,outbuf,outcnt);
  116.      outcnt:=0;
  117.    end;
  118. end;
  119.  
  120.  
  121. Procedure TAsmList.AsmWrite(const s:string);
  122. begin
  123.   if OutCnt+length(s)>=AsmOutSize then
  124.    AsmFlush;
  125.   Move(s[1],OutBuf[OutCnt],length(s));
  126.   inc(OutCnt,length(s));
  127. end;
  128.  
  129.  
  130. Procedure TAsmList.AsmWriteLn(const s:string);
  131. begin
  132.   AsmWrite(s);
  133.   AsmWrite(target_info.newline);
  134. end;
  135.  
  136.  
  137. Procedure TAsmList.AsmWritePChar(p:pchar);
  138. var
  139.   i,j : longint;
  140. begin
  141.   i:=StrLen(p);
  142.   j:=i;
  143.   while j>0 do
  144.    begin
  145.      i:=min(j,AsmOutSize);
  146.      if OutCnt+i>=AsmOutSize then
  147.       AsmFlush;
  148.      Move(p[0],OutBuf[OutCnt],i);
  149.      inc(OutCnt,i);
  150.      dec(j,i);
  151.      p:=pchar(@p[i]);
  152.    end;
  153. end;
  154.  
  155.  
  156.  
  157.  
  158. Procedure TAsmList.AsmLn;
  159. begin
  160.   AsmWrite(target_info.newline);
  161. end;
  162.  
  163.  
  164. procedure TAsmList.OpenAsmList(const fn,fn2:string);
  165. begin
  166. {$ifdef linux}
  167.   if DoPipe then
  168.    begin
  169.      Message1(exec_i_assembling_pipe,fn);
  170.      POpen(outfile,'as -o '+fn2,'W');
  171.    end
  172.   else
  173. {$endif}
  174.    begin
  175.      Assign(outfile,fn);
  176.      {$I-}
  177.       Rewrite(outfile,1);
  178.      {$I+}
  179.      if ioresult<>0 then
  180.       Message1(exec_d_cant_create_asmfile,fn);
  181.    end;
  182.   outcnt:=0;
  183. end;
  184.  
  185.  
  186. procedure TAsmList.CloseAsmList;
  187. var
  188.   f : file;
  189.   l : longint;
  190. begin
  191.   AsmFlush;
  192. {$ifdef linux}
  193.   if DoPipe then
  194.    Close(outfile)
  195.   else
  196. {$endif}
  197.    begin
  198.    {Touch Assembler time to ppu time is there is a ppufilename}
  199.      if Assigned(current_module^.ppufilename) then
  200.       begin
  201.         Assign(f,current_module^.ppufilename^);
  202.         reset(f,1);
  203.         if ioresult=0 then
  204.          begin
  205.            getftime(f,l);
  206.            close(f);
  207.            reset(outfile,1);
  208.            setftime(outfile,l);
  209.          end;
  210.       end;
  211.      close(outfile);
  212.    end;
  213. end;
  214.  
  215.  
  216. procedure TAsmList.WriteTree(p:paasmoutput);
  217. begin
  218. end;
  219.  
  220.  
  221. procedure TAsmList.WriteAsmList;
  222. begin
  223. end;
  224.  
  225.  
  226. constructor TAsmList.Init;
  227. begin
  228.   OutCnt:=0;
  229. end;
  230.  
  231.  
  232. destructor TAsmList.Done;
  233. begin
  234. end;
  235.  
  236.  
  237. {*****************************************************************************
  238.                                   TASMFILE
  239. *****************************************************************************}
  240.  
  241. Constructor TAsmFile.Init(const fn:string);
  242. var
  243.   name:namestr;
  244.   ext:extstr;
  245. begin
  246. {Create filenames for easier access}
  247.   fsplit(fn,path,name,ext);
  248.   srcfile:=fn;
  249.   asmfile:=path+name+target_info.asmext;
  250.   objfile:=path+name+target_info.objext;
  251. {Init output format}
  252.   case current_module^.output_format of
  253. {$ifdef i386}
  254.      of_o,
  255.      of_win32,
  256.      of_att:
  257.        asmlist:=new(pi386attasmlist,Init);
  258.      of_obj,
  259.      of_masm,
  260.      of_nasm:
  261.        asmlist:=new(pi386intasmlist,Init);
  262. {$endif}
  263. {$ifdef m68k}
  264.    of_o,
  265.    of_gas : asmlist:=new(pm68kgasasmlist,Init);
  266.    of_mot : asmlist:=new(pm68kmotasmlist,Init);
  267.    of_mit : asmlist:=new(pm68kmitasmlist,Init);
  268. {$endif}
  269.   else
  270.    internalerror(30000);
  271.   end;
  272. end;
  273.  
  274.  
  275. Destructor TAsmFile.Done;
  276. begin
  277. end;
  278.  
  279.  
  280. Procedure TAsmFile.WriteAsmSource;
  281. begin
  282.   asmlist^.OpenAsmList(asmfile,objfile);
  283.   asmlist^.WriteAsmList;
  284.   asmlist^.CloseAsmList;
  285. end;
  286.  
  287.  
  288. const
  289.   last_of  : tof=of_none;
  290. var
  291.   LastASBin : string;
  292. Function TAsmFile.FindAssembler(curr_of:tof):string;
  293. var
  294.   asfound : boolean;
  295. begin
  296.   if last_of<>curr_of then
  297.    begin
  298.      last_of:=curr_of;
  299.      LastASBin:=FindExe(asbin[curr_of],asfound);
  300.      if (not asfound) and (not externasm) then
  301.       begin
  302.         Message1(exec_w_assembler_not_found,LastASBin);
  303.         externasm:=true;
  304.       end;
  305.      if asfound then
  306.       Message1(exec_u_using_assembler,LastASBin);
  307.    end;
  308.   FindAssembler:=LastASBin;
  309. end;
  310.  
  311.  
  312. Function TAsmFile.CallAssembler(const command,para:string):Boolean;
  313. begin
  314.   if not externasm then
  315.    begin
  316.      swapvectors;
  317.      exec(command,para);
  318.      swapvectors;
  319.      if (dosexitcode<>0) then
  320.       begin
  321.         Message(exec_w_error_while_assembling);
  322.         callassembler:=false;
  323.         exit;
  324.       end
  325.      else
  326.       if (doserror<>0) then
  327.        begin
  328.          Message(exec_w_cant_call_assembler);
  329.          externasm:=true;
  330.        end;
  331.    end;
  332.   if externasm then
  333.    AsmRes.AddAsmCommand(command,para,asmfile);
  334.   callassembler:=true;
  335. end;
  336.  
  337.  
  338. procedure TAsmFile.RemoveAsm;
  339. var
  340.   g : file;
  341.   i : word;
  342. begin
  343.   if writeasmfile then
  344.    exit;
  345.   if ExternAsm then
  346.    AsmRes.AddDeleteCommand (AsmFile)
  347.   else
  348.    begin
  349.      assign(g,asmfile);
  350.      {$I-}
  351.       erase(g);
  352.      {$I+}
  353.      i:=ioresult;
  354.    end;
  355. end;
  356.  
  357.  
  358. Function TAsmFile.DoAssemble:boolean;
  359. begin
  360.   if DoPipe then
  361.    exit;
  362.   if not externasm then
  363.    Message1(exec_i_assembling,asmfile);
  364.   case current_module^.output_format of
  365. {$ifdef i386}
  366.    of_att : begin
  367.               externasm:=true; {Force Extern Asm}
  368.               if CallAssembler(FindAssembler(of_att),' -D -o '+objfile+' '+asmfile) then
  369.                RemoveAsm;
  370.             end;
  371.      of_o : begin
  372.               if CallAssembler(FindAssembler(of_o),'-D -o '+objfile+' '+asmfile) then
  373.                RemoveAsm;
  374.             end;
  375.  of_win32 : begin
  376.               if CallAssembler(FindAssembler(of_win32),'-D -o '+objfile+' '+asmfile) then
  377.                RemoveAsm;
  378.             end;
  379.   of_nasm : begin
  380.             {$ifdef linux}
  381.               if CallAssembler(FindAssembler(of_nasm),' -f elf -o '+objfile+' '+asmfile) then
  382.                RemoveAsm;
  383.             {$else}
  384.               if CallAssembler(FindAssembler(of_nasm),' -f coff -o '+objfile+' '+asmfile) then
  385.                RemoveAsm;
  386.             {$endif}
  387.             end;
  388.    of_obj : begin
  389.               if CallAssembler(FindAssembler(of_nasm),' -f obj -o '+objfile+' '+asmfile) then
  390.                RemoveAsm;
  391.             end;
  392.   of_masm : begin
  393.             { !! Nothing yet !! }
  394.             end;
  395. {$endif}
  396. {$ifdef m68k}
  397.    of_mot : begin
  398.              { !! Nothing yet !! }
  399.             end;
  400.    of_mit : begin
  401.             end;
  402.    of_o :   begin
  403.               if CallAssembler(FindAssembler(of_gas),' -o '+objfile+' '+asmfile) then
  404.                RemoveAsm;
  405.             end;
  406.    of_gas : begin
  407.              { !! Nothing yet !! }
  408.             end;
  409. {$endif}
  410.   else
  411.    internalerror(30000);
  412.   end;
  413.   DoAssemble:=true;
  414. end;
  415.  
  416. end.
  417. {
  418.   $Log: assemble.pas,v $
  419.   Revision 1.1.1.1.2.2  1998/08/13 13:33:16  carl
  420.     + assembling is automatically tried with -Ao switch (default)
  421.  
  422.   Revision 1.1.1.1.2.1  1998/04/08 11:38:43  peter
  423.     * nasm patches, pierres symtable patch
  424.  
  425.   Revision 1.1.1.1  1998/03/25 11:18:16  root
  426.   * Restored version
  427.  
  428.   Revision 1.17  1998/03/10 13:23:00  florian
  429.     * small win32 problems fixed
  430.  
  431.   Revision 1.16  1998/03/10 01:17:14  peter
  432.     * all files have the same header
  433.     * messages are fully implemented, EXTDEBUG uses Comment()
  434.     + AG... files for the Assembler generation
  435.  
  436.   Revision 1.15  1998/03/09 10:37:41  peter
  437.     * fixed very long pchar writing (> outbufsize)
  438.  
  439.   Revision 1.14  1998/03/05 22:43:45  florian
  440.     * some win32 support stuff added
  441.  
  442.   Revision 1.13  1998/03/04 14:18:58  michael
  443.   * modified messaging system
  444.  
  445.   Revision 1.12  1998/03/04 01:34:51  peter
  446.     * messages for unit-handling and assembler/linker
  447.     * the compiler compiles without -dGDB, but doesn't work yet
  448.     + -vh for Hint
  449.  
  450.   Revision 1.11  1998/03/02 01:48:05  peter
  451.     * renamed target_DOS to target_GO32V1
  452.     + new verbose system, merged old errors and verbose units into one new
  453.       verbose.pas, so errors.pas is obsolete
  454.  
  455.   Revision 1.10  1998/02/26 11:57:00  daniel
  456.   * New assembler optimizations commented out, because of bugs.
  457.   * Use of dir-/name- and extstr.
  458.  
  459.   Revision 1.9  1998/02/24 10:29:12  peter
  460.     * -a works again
  461.  
  462.   Revision 1.8  1998/02/21 03:31:40  carl
  463.     + mit68k asm support.
  464.  
  465.   Revision 1.7  1998/02/18 14:18:16  michael
  466.   + added log at end of file (retroactively)
  467.  
  468.   revision 1.6
  469.   date: 1998/02/18 13:43:11;  author: michael;  state: Exp;  lines: +3 -19
  470.   + Implemented an OS independent AsmRes object.
  471.   ----------------------------
  472.   revision 1.5
  473.   date: 1998/02/17 21:20:28;  author: peter;  state: Exp;  lines: +60 -54
  474.     + Script unit
  475.     + __EXIT is called again to exit a program
  476.     - target_info.link/assembler calls
  477.     * linking works again for dos
  478.     * optimized a few filehandling functions
  479.     * fixed stabs generation for procedures
  480.   ----------------------------
  481.   revision 1.4
  482.   date: 1998/02/16 12:51:27;  author: michael;  state: Exp;  lines: +2 -2
  483.   + Implemented linker object
  484.   ----------------------------
  485.   revision 1.3
  486.   date: 1998/02/15 21:15:58;  author: peter;  state: Exp;  lines: +8 -9
  487.     * all assembler outputs supported by assemblerobject
  488.     * cleanup with assembleroutputs, better .ascii generation
  489.     * help_constructor/destructor are now added to the externals
  490.     - generation of asmresponse is not outputformat depended
  491.   ----------------------------
  492.   revision 1.2
  493.   date: 1998/02/14 01:45:04;  author: peter;  state: Exp;  lines: +3 -14
  494.     * more fixes
  495.     - pmode target is removed
  496.     - search_as_ld is removed, this is done in the link.pas/assemble.pas
  497.     + findexe() to search for an executable (linker,assembler,binder)
  498.   ----------------------------
  499.   revision 1.1
  500.   date: 1998/02/13 22:28:16;  author: peter;  state: Exp;
  501.     + Initial implementation
  502. }
  503.