home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 2 / AACD 2.iso / AACD / Programming / fpc / compiler / radi386.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-09-24  |  13.0 KB  |  301 lines
  1. {
  2.     $Id: radi386.pas,v 1.1.1.1 1998/03/25 11:18:15 root Exp $
  3.     Copyright (c) 1998 by Florian Klaempfl
  4.  
  5.     Reads inline assembler and writes the lines direct to the output
  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 radi386;
  24.  
  25.   interface
  26.  
  27.     uses
  28.       tree;
  29.  
  30.      function assemble : ptree;
  31.  
  32.   implementation
  33.  
  34.      uses
  35.         i386,hcodegen,globals,scanner,aasm,
  36.         cobjects,symtable,types,verbose,asmutils;
  37.  
  38.     function assemble : ptree;
  39.  
  40.       var
  41.          retstr,s,hs : string;
  42.          c : char;
  43.          ende : boolean;
  44.          sym : psym;
  45.          code : paasmoutput;
  46.          l : longint;
  47.  
  48.        procedure writeasmline;
  49.          var
  50.            i : longint;
  51.          begin
  52.            i:=length(s);
  53.            while (i>0) and (s[i] in [' ',#9]) do
  54.             dec(i);
  55.            s[0]:=chr(i);
  56.            if s<>'' then
  57.             code^.concat(new(pai_direct,init(strpnew(s))));
  58.             { if function return is param }
  59.             { consider it set if the offset was loaded }
  60.            if assigned(procinfo.retdef) and
  61.               ret_in_param(procinfo.retdef) and
  62.               (pos(retstr,upper(s))>0) then
  63.               procinfo.funcret_is_valid:=true;
  64.            s:='';
  65.          end;
  66.  
  67.      begin
  68.        ende:=false;
  69.        s:='';
  70.        if assigned(procinfo.retdef) and
  71.           (procinfo.retdef<>pdef(voiddef)) then
  72.          retstr:=upper(tostr(procinfo.retoffset)+'('+att_reg2str[procinfo.framepointer]+')')
  73.        else
  74.          retstr:='';
  75.        c:=asmgetchar;
  76.          code:=new(paasmoutput,init);
  77.          while not(ende) do
  78.            begin
  79.               case c of
  80.                  'A'..'Z','a'..'z','_' : begin
  81.                       hs:='';
  82.                       while ((ord(c)>=ord('A')) and (ord(c)<=ord('Z')))
  83.                          or ((ord(c)>=ord('a')) and (ord(c)<=ord('z')))
  84.                          or ((ord(c)>=ord('0')) and (ord(c)<=ord('9')))
  85.                          or (c='_') do
  86.                         begin
  87.                            inc(byte(hs[0]));
  88.                            hs[length(hs)]:=c;
  89.                            c:=asmgetchar;
  90.                         end;
  91.                       if upper(hs)='END' then
  92.                          ende:=true
  93.                       else
  94.                          begin
  95.                             if c=':' then
  96.                               begin
  97.                                 getsym(upper(hs),false);
  98.                                 if srsym<>nil then
  99.                                   Message(assem_w_using_defined_as_local);
  100.                               end;
  101.                             if upper(hs)='FWAIT' then
  102.                              FwaitWarning
  103.                             else
  104.                             { access to local variables }
  105.                             if assigned(aktprocsym) then
  106.                               begin
  107.                                  { is the last written character an special }
  108.                                  { char ?                                   }
  109.                                  if (s[length(s)]<>'%') and
  110.                                    (s[length(s)]<>'$') then
  111.                                    begin
  112.                                       if assigned(aktprocsym^.definition^.localst) then
  113.                                         sym:=aktprocsym^.definition^.localst^.search(upper(hs))
  114.                                       else
  115.                                         sym:=nil;
  116.                                       if assigned(sym) then
  117.                                         begin
  118.                                            if sym^.typ=varsym then
  119.                                              begin
  120.                                              {variables set are after a comma }
  121.                                              {like in movl %eax,I }
  122.                                              if pos(',',s) > 0 then
  123.                                                pvarsym(sym)^.is_valid:=1
  124.                                              else
  125.                                              if (pos('MOV',upper(s)) > 0) and (pvarsym(sym)^.is_valid=0) then
  126.                                               Message1(sym_n_local_var_not_init_yet,hs);
  127.                                              hs:='-'+tostr(pvarsym(sym)^.address)+'('+att_reg2str[procinfo.framepointer]+')';
  128.                                              end
  129.                                            else
  130.                                            { call to local function }
  131.                                            if (sym^.typ=procsym) and (pos('CALL',upper(s))>0) then
  132.                                              begin
  133.                                                 hs:=pprocsym(sym)^.definition^.mangledname;
  134.                                              end;
  135.                                         end
  136.                                       else
  137.                                         begin
  138.                                            if assigned(aktprocsym^.definition^.parast) then
  139.                                              sym:=aktprocsym^.definition^.parast^.search(upper(hs))
  140.                                            else
  141.                                              sym:=nil;
  142.                                            if assigned(sym) then
  143.                                              begin
  144.                                                 if sym^.typ=varsym then
  145.                                                   begin
  146.                                                      l:=pvarsym(sym)^.address;
  147.                                                      { set offset }
  148.                                                      inc(l,aktprocsym^.definition^.parast^.call_offset);
  149.                                                      hs:=tostr(l)+'('+att_reg2str[procinfo.framepointer]+')';
  150.                                                      if pos(',',s) > 0 then
  151.                                                        pvarsym(sym)^.is_valid:=1;
  152.                                                   end;
  153.                                              end
  154.                                       { I added that but it creates a problem in line.ppi
  155.                                       because there is a local label wbuffer and
  156.                                       a static variable WBUFFER ...
  157.                                       what would you decide, florian ?
  158.                                       else
  159.  
  160.                                         begin
  161.                                            getsym(upper(hs),false);
  162.                                            sym:=srsym;
  163.                                            if assigned(sym) and (sym^.typ = varsym)
  164.                                               or (sym^.typ = typedconstsym) then
  165.                                              hs:=sym^.mangledname;
  166.                                            if (sym^.typ=procsym) and (pos('CALL',upper(s))>0) then
  167.                                              begin
  168.                                                 if assigned(pprocsym(sym)^.definition^.nextoverloaded) then
  169.                                                   begin
  170.                                                      exterror:=strpnew(' calling an overloaded procedure in asm');
  171.                                                      warning(user_defined);
  172.                                                   end;
  173.                                                 hs:=pprocsym(sym)^.definition^.mangledname;
  174.                                              end;
  175.                                         end   }
  176.                                            else if upper(hs)='__SELF' then
  177.                                              begin
  178.                                                 if assigned(procinfo._class) then
  179.                                                   hs:=tostr(procinfo.ESI_offset)+'('+att_reg2str[procinfo.framepointer]+')'
  180.                                                 else
  181.                                                  Message(assem_e_cannot_use_SELF_outside_a_method);
  182.                                              end
  183.                                            else if upper(hs)='__RESULT' then
  184.                                              begin
  185.                                                 if assigned(procinfo.retdef) and
  186.                                                   (procinfo.retdef<>pdef(voiddef)) then
  187.                                                   begin
  188.                                                   hs:=retstr;
  189.                                                   if pos(',',s) > 0 then
  190.                                                     procinfo.funcret_is_valid:=true;
  191.                                                   end
  192.                                                 else
  193.                                                  Message(assem_w_void_function);
  194.                                              end
  195.                                            else if upper(hs)='__OLDEBP' then
  196.                                              begin
  197.                                                             { complicate to check there }
  198.                                                             { we do it: }
  199.                                                 if lexlevel>2 then
  200.                                                   hs:=tostr(procinfo.framepointer_offset)
  201.                                                                 +'('+att_reg2str[procinfo.framepointer]+')'
  202.                                                 else
  203.                                                   Message(assem_e_cannot_use___OLDEBP_outside_nested_procedure);
  204.                                                 end;
  205.                                            end;
  206.                                        { end;}
  207.                                    end;
  208.                               end;
  209.                             s:=s+hs;
  210.                          end;
  211.                    end;
  212.  '{',';',#10,#13 : begin
  213.                      writeasmline;
  214.                      c:=asmgetchar;
  215.                    end;
  216.              #26 : Message(scan_f_end_of_file);
  217.              else
  218.                begin
  219.                  inc(byte(s[0]));
  220.                  s[length(s)]:=c;
  221.                  c:=asmgetchar;
  222.                end;
  223.            end;
  224.          end;
  225.        writeasmline;
  226.        assemble:=genasmnode(code);
  227.      end;
  228.  
  229. end.
  230. {
  231.   $Log: radi386.pas,v $
  232.   Revision 1.1.1.1  1998/03/25 11:18:15  root
  233.   * Restored version
  234.  
  235.   Revision 1.13  1998/03/24 21:48:33  florian
  236.     * just a couple of fixes applied:
  237.          - problem with fixed16 solved
  238.          - internalerror 10005 problem fixed
  239.          - patch for assembler reading
  240.          - small optimizer fix
  241.          - mem is now supported
  242.  
  243.   Revision 1.12  1998/03/10 16:27:43  pierre
  244.     * better line info in stabs debug
  245.     * symtabletype and lexlevel separated into two fields of tsymtable
  246.     + ifdef MAKELIB for direct library output, not complete
  247.     + ifdef CHAINPROCSYMS for overloaded seach across units, not fully
  248.       working
  249.     + ifdef TESTFUNCRET for setting func result in underfunction, not
  250.       working
  251.  
  252.   Revision 1.11  1998/03/10 01:17:26  peter
  253.     * all files have the same header
  254.     * messages are fully implemented, EXTDEBUG uses Comment()
  255.     + AG... files for the Assembler generation
  256.  
  257.   Revision 1.10  1998/03/09 12:58:12  peter
  258.     * FWait warning is only showed for Go32V2 and $E+
  259.     * opcode tables moved to i386.pas/m68k.pas to reduce circular uses (and
  260.       for m68k the same tables are removed)
  261.     + $E for i386
  262.  
  263.   Revision 1.9  1998/03/06 00:52:51  peter
  264.     * replaced all old messages from errore.msg, only ExtDebug and some
  265.       Comment() calls are left
  266.     * fixed options.pas
  267.  
  268.   Revision 1.8  1998/03/03 16:45:23  peter
  269.     + message support for assembler parsers
  270.  
  271.   Revision 1.7  1998/03/02 01:49:14  peter
  272.     * renamed target_DOS to target_GO32V1
  273.     + new verbose system, merged old errors and verbose units into one new
  274.       verbose.pas, so errors.pas is obsolete
  275.  
  276.   Revision 1.6  1998/02/13 10:35:35  daniel
  277.   * Made Motorola version compilable.
  278.   * Fixed optimizer
  279.  
  280.   Revision 1.5  1998/02/07 18:01:27  carl
  281.     + fwait warning for emulation
  282.  
  283.   Revision 1.3  1997/11/30 18:12:17  carl
  284.   * bugfix of line numbering.
  285.  
  286.   Revision 1.2  1997/11/28 18:14:44  pierre
  287.    working version with several bug fixes
  288.  
  289.   Revision 1.1.1.1  1997/11/27 08:33:00  michael
  290.   FPC Compiler CVS start
  291.  
  292.  
  293.   Pre-CVS log:
  294.  
  295.   History:
  296.       19th october 1996:
  297.          + created from old asmbl.pas
  298.       13th october 1996:
  299.          + renamed to radi386
  300. }
  301.