home *** CD-ROM | disk | FTP | other *** search
/ AmigActive 2 / AACD 2.iso / AACD / Programming / fpc / compiler / aasm.pas next >
Encoding:
Pascal/Delphi Source File  |  1998-09-24  |  20.9 KB  |  768 lines
  1. {
  2.     $Id: aasm.pas,v 1.1.1.1 1998/03/25 11:18:16 root Exp $
  3.     Copyright (c) 1996-98 by Florian Klaempfl
  4.  
  5.     This unit implements an abstract asmoutput class for all processor types
  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 aasm;
  24.  
  25.   interface
  26.  
  27.     uses
  28.        cobjects,files,globals;
  29.  
  30. {$I version.inc}
  31.     type
  32. {$ifdef klaempfl}
  33. {$ifdef ver0_9_2}
  34.        extended = double;
  35. {$endif ver0_9_2}
  36. {$endif klaempfl}
  37.        tait = (
  38.           ait_string,
  39.           ait_label,
  40.           ait_direct,
  41.           ait_labeled_instruction,
  42.           ait_comment,
  43.           ait_instruction,
  44.           ait_datablock,
  45.           ait_symbol,
  46.           ait_const_32bit,
  47.           ait_const_symbol,
  48.           ait_const_16bit,
  49.           ait_const_8bit,
  50.           ait_real_64bit,
  51.           ait_real_32bit,
  52.           ait_real_extended,
  53.           ait_comp,
  54.           ait_external,
  55.           ait_align,
  56.  
  57.           { the following is only used by the win32 version of the compiler }
  58.           { and only the GNU AS Win32 is able to write it                   }
  59.           ait_section,
  60.           ait_const_rva,
  61.           { the following must is system depended }
  62. {$ifdef GDB}
  63.           ait_stabn,
  64.           ait_stabs,
  65.           ait_stab_function_name,
  66. {$endif GDB}
  67. {$ifdef MAKELIB}
  68.           { used to split unit into tiny assembler files }
  69.           ait_cut,
  70. {$endif MAKELIB}
  71.           { never used, makes insertation of new ait_ easier to type }
  72.           ait_dummy);
  73.  
  74.      type
  75.        { the short name makes typing easier }
  76.        pai = ^tai;
  77.  
  78.        tai = object(tlinkedlist_item)
  79.           typ : tait;
  80.           line : longint;
  81.           infile : pinputfile;
  82.           constructor init;
  83.        end;
  84.  
  85.        pai_string = ^tai_string;
  86.  
  87.        tai_string = object(tai)
  88.           str : pchar;
  89.           { extra len so the string can contain an \0 }
  90.           len : longint;
  91.           constructor init(const _str : string);
  92.           constructor init_pchar(_str : pchar);
  93.           destructor done;virtual;
  94.        end;
  95.  
  96.        pai_symbol = ^tai_symbol;
  97.  
  98.        { generates a common label }
  99.        tai_symbol = object(tai)
  100.           name : pchar;
  101.           is_global : boolean;
  102.           constructor init(const _name : string);
  103.           constructor init_global(const _name : string);
  104.           destructor done;virtual;
  105.        end;
  106.  
  107.        { external types defined for TASM }
  108.        { EXT_ANY for search purposes     }
  109.        texternal_typ = (EXT_ANY,EXT_NEAR, EXT_FAR, EXT_PROC, EXT_BYTE,
  110.                        EXT_WORD, EXT_DWORD, EXT_CODEPTR, EXT_DATAPTR,
  111.                        EXT_FWORD, EXT_PWORD, EXT_QWORD, EXT_TBYTE, EXT_ABS);
  112.  
  113.        pai_external = ^tai_external;
  114.  
  115.        { generates an symbol which is marked as external }
  116.        tai_external = object(tai)
  117.           name : pchar;
  118.           exttyp : texternal_typ;
  119.           constructor init(const _name : string;exttype : texternal_typ);
  120.           destructor done; virtual;
  121.        end;
  122.  
  123.        { simple temporary label }
  124.        pai_label = ^tai_label;
  125.  
  126.        { type for a temporary label }
  127.        { test if used for dispose of unnecessary labels }
  128.        tlabel = record
  129.                 nb : longint;
  130.                 is_used : boolean;
  131.                 is_set : boolean;
  132.                 refcount : word;
  133.                 end;
  134.  
  135.        plabel = ^tlabel;
  136.  
  137.        tai_label = object(tai)
  138.           l : plabel;
  139.           constructor init(_l : plabel);
  140.           destructor done; virtual;
  141.        end;
  142.  
  143.        pai_direct = ^tai_direct;
  144.        tai_direct = object(tai)
  145.           str : pchar;
  146.           constructor init(_str : pchar);
  147.           destructor done; virtual;
  148.        end;
  149.  
  150.  
  151.        { alignment for operator }
  152.        pai_align = ^tai_align;
  153.        tai_align = object(tai)
  154.           aligntype: byte;   { 1 = no align, 2 = word align, 4 = dword align }
  155.           op: byte;          { value to fill with - optional                 }
  156.           constructor init(b:byte);
  157.           constructor init_op(b: byte; use_op: byte);
  158.           destructor done;virtual;
  159.        end;
  160.  
  161.        pai_section = ^tai_section;
  162.  
  163.        tai_section = object(tai)
  164.           name : pstring;
  165.           constructor init(const s : string);
  166.           destructor done;virtual;
  167.        end;
  168.  
  169.        pai_datablock = ^tai_datablock;
  170.  
  171.        { generates an uninitilizised data block }
  172.        tai_datablock = object(tai)
  173.           size : longint;
  174.           name : pchar;
  175.           is_global : boolean;
  176.           constructor init(const _name : string;_size : longint);
  177.           constructor init_global(const _name : string;_size : longint);
  178.           destructor done; virtual;
  179.        end;
  180.  
  181.        pai_const = ^tai_const;
  182.  
  183.        { generates a long integer (32 bit) }
  184.        tai_const = object(tai)
  185.           value : longint;
  186.           constructor init_32bit(_value : longint);
  187.           constructor init_16bit(_value : word);
  188.           constructor init_8bit(_value : byte);
  189.           constructor init_symbol(p : pchar);
  190.           constructor init_rva(p : pchar);
  191.           destructor done;virtual;
  192.        end;
  193.  
  194.        pai_double = ^tai_double;
  195.  
  196.        { generates a double (64 bit real) }
  197.        tai_double = object(tai)
  198.           value : double;
  199.           constructor init(_value : double);
  200.        end;
  201.  
  202.        pai_single = ^tai_single;
  203.  
  204.        { generates a single (32 bit real) }
  205.        tai_single = object(tai)
  206.           value : single;
  207.           constructor init(_value : single);
  208.        end;
  209.  
  210.        pai_extended = ^tai_extended;
  211.  
  212.        { generates an extended (80 bit real) }
  213.        { for version above v0_9_8            }
  214.        { creates a double otherwise          }
  215.        tai_extended = object(tai)
  216.           value : bestreal;
  217.           constructor init(_value : bestreal);
  218.        end;
  219. {$ifdef MAKELIB}
  220.        pai_cut = ^tai_cut;
  221.  
  222.        tai_cut = object(tai)
  223.           constructor init;
  224.        end;
  225. {$endif MAKELIB}
  226.  
  227. { for each processor define the best precision }
  228. { bestreal is defined in globals }
  229. {$ifdef i386}
  230. {$ifdef ver_above0_9_8}
  231. const
  232.        ait_bestreal = ait_real_extended;
  233. type
  234.        pai_bestreal = pai_extended;
  235.        tai_bestreal = tai_extended;
  236. {$else ver_above0_9_8}
  237. const
  238.        ait_bestreal = ait_real_64bit;
  239. type
  240.        pai_bestreal = pai_double;
  241.        tai_bestreal = tai_double;
  242. {$endif ver_above0_9_8}
  243. {$endif i386}
  244. {$ifdef m68k}
  245. const
  246.        ait_bestreal = ait_real_32bit;
  247. type
  248.        pai_bestreal = pai_single;
  249.        tai_bestreal = tai_single;
  250. {$endif m68k}
  251.  
  252.        pai_comp = ^tai_comp;
  253.  
  254.        { generates an comp (integer over 64 bits) }
  255.        tai_comp = object(tai)
  256.           value : bestreal;
  257.           constructor init(_value : bestreal);
  258.        end;
  259.  
  260.        paasmoutput = ^taasmoutput;
  261.        taasmoutput = tlinkedlist;
  262.  
  263.     var
  264.       datasegment,codesegment,bsssegment,
  265.       internals,externals,debuglist,consts,importssection,
  266.       exportssection,resourcesection : paasmoutput;
  267.  
  268.    { external symbols without repetition }
  269.     function search_assembler_symbol(pl : paasmoutput;const _name : string;exttype : texternal_typ) : pai_external;
  270.     procedure concat_external(const _name : string;exttype : texternal_typ);
  271.     procedure concat_internal(const _name : string;exttype : texternal_typ);
  272.  
  273.   implementation
  274.  
  275.   uses strings,verbose;
  276.  
  277. {****************************************************************************
  278.                              TAI
  279.  ****************************************************************************}
  280.  
  281.     constructor tai.init;
  282.  
  283.       begin
  284. {$ifdef GDB}
  285.          infile:=pointer(current_module^.current_inputfile);
  286.          if assigned(infile) then
  287.            line:=current_module^.current_inputfile^.line_no;
  288. {$endif GDB}
  289.       end;
  290. {****************************************************************************
  291.                              TAI_SECTION
  292.  ****************************************************************************}
  293.  
  294.     constructor tai_section.init(const s : string);
  295.  
  296.       begin
  297.          inherited init;
  298.          typ:=ait_section;
  299.          name:=stringdup(s);
  300.       end;
  301.  
  302.     destructor tai_section.done;
  303.  
  304.       begin
  305.          stringdispose(name);
  306.          inherited done;
  307.       end;
  308.  
  309. {****************************************************************************
  310.                              TAI_DATABLOCK
  311.  ****************************************************************************}
  312.  
  313.     constructor tai_datablock.init(const _name : string;_size : longint);
  314.  
  315.       begin
  316.          inherited init;
  317.          typ:=ait_datablock;
  318.          name:=strpnew(_name);
  319.          concat_internal(_name,EXT_ANY);
  320.          size:=_size;
  321.          is_global:=false;
  322.       end;
  323.  
  324.     constructor tai_datablock.init_global(const _name : string;_size : longint);
  325.  
  326.       begin
  327.          inherited init;
  328.          typ:=ait_datablock;
  329.          name:=strpnew(_name);
  330.          concat_internal(_name,EXT_ANY);
  331.          size:=_size;
  332.          is_global:=true;
  333.       end;
  334.  
  335.     destructor tai_datablock.done;
  336.  
  337.       begin
  338.          strdispose(name);
  339.          inherited done;
  340.       end;
  341.  
  342. {****************************************************************************
  343.                                TAI_SYMBOL
  344.  ****************************************************************************}
  345.  
  346.     constructor tai_symbol.init(const _name : string);
  347.  
  348.       begin
  349.          inherited init;
  350.          typ:=ait_symbol;
  351.          name:=strpnew(_name);
  352.          concat_internal(_name,EXT_ANY);
  353.          is_global:=false;
  354.       end;
  355.  
  356.     constructor tai_symbol.init_global(const _name : string);
  357.  
  358.       begin
  359.          inherited init;
  360.          typ:=ait_symbol;
  361.          name:=strpnew(_name);
  362.          concat_internal(_name,EXT_ANY);
  363.          is_global:=true;
  364.       end;
  365.  
  366.     destructor tai_symbol.done;
  367.  
  368.       begin
  369.          strdispose(name);
  370.          inherited done;
  371.       end;
  372.  
  373. {****************************************************************************
  374.                                TAI_EXTERNAL
  375.  ****************************************************************************}
  376.  
  377.     constructor tai_external.init(const _name : string;exttype : texternal_typ);
  378.  
  379.       begin
  380.          inherited init;
  381.          typ:=ait_external;
  382.          exttyp:=exttype;
  383.          name:=strpnew(_name);
  384.       end;
  385.  
  386.     destructor tai_external.done;
  387.  
  388.       begin
  389.          strdispose(name);
  390.          inherited done;
  391.       end;
  392.  
  393.     function search_assembler_symbol(pl : paasmoutput;const _name : string;exttype : texternal_typ) : pai_external;
  394.  
  395.       var
  396.          p : pai;
  397.  
  398.       begin
  399.          search_assembler_symbol:=nil;
  400.          if pl=nil then
  401.            internalerror(2001)
  402.          else
  403.            begin
  404.               p:=pai(pl^.first);
  405.               while (p<>nil) and
  406.                     (p<>pai(pl^.last)) do
  407.                 { if we get the same name with a different typ }
  408.                 { there is probably an error                   }
  409.                 if (p^.typ=ait_external) and
  410.                    ((exttype=EXT_ANY) or (pai_external(p)^.exttyp=exttype)) and
  411.                    (strpas(pai_external(p)^.name)=_name) then
  412.                   begin
  413.                      search_assembler_symbol:=pai_external(p);
  414.                      exit;
  415.                   end
  416.                 else
  417.                   p:=pai(p^.next);
  418.               if (p<>nil) and
  419.                  (p^.typ=ait_external) and
  420.                  (pai_external(p)^.exttyp=exttype) and
  421.                  (strpas(pai_external(p)^.name)=_name) then
  422.                 begin
  423.                    search_assembler_symbol:=pai_external(p);
  424.                    exit;
  425.                 end;
  426.            end;
  427.       end;
  428.  
  429.     { insert each need external only once }
  430.     procedure concat_external(const _name : string;exttype : texternal_typ);
  431.  
  432.       var
  433.          p : pai_external;
  434.  
  435.       begin
  436.          p:=search_assembler_symbol(externals,_name,exttype);
  437.          if p=nil then
  438.            externals^.concat(new(pai_external,init(_name,exttype)));
  439.       end;
  440.  
  441.     { insert each need external only once }
  442.     procedure concat_internal(const _name : string;exttype : texternal_typ);
  443.  
  444.       var
  445.          p : pai_external;
  446.  
  447.       begin
  448.          p:=search_assembler_symbol(internals,_name,exttype);
  449.          if p=nil then
  450.            internals^.concat(new(pai_external,init(_name,exttype)));
  451.       end;
  452.  
  453. {****************************************************************************
  454.                                TAI_CONST
  455.  ****************************************************************************}
  456.  
  457.     constructor tai_const.init_32bit(_value : longint);
  458.  
  459.       begin
  460.          inherited init;
  461.          typ:=ait_const_32bit;
  462.          value:=_value;
  463.       end;
  464.  
  465.     constructor tai_const.init_16bit(_value : word);
  466.  
  467.       begin
  468.          inherited init;
  469.          typ:=ait_const_16bit;
  470.          value:=_value;
  471.       end;
  472.  
  473.     constructor tai_const.init_8bit(_value : byte);
  474.  
  475.       begin
  476.          inherited init;
  477.          typ:=ait_const_8bit;
  478.          value:=_value;
  479.       end;
  480.  
  481.     constructor tai_const.init_symbol(p : pchar);
  482.  
  483.       begin
  484.          inherited init;
  485.          typ:=ait_const_symbol;
  486.          value:=longint(p);
  487.       end;
  488.  
  489.     constructor tai_const.init_rva(p : pchar);
  490.  
  491.       begin
  492.          inherited init;
  493.          typ:=ait_const_rva;
  494.          value:=longint(p);
  495.       end;
  496.  
  497.     destructor tai_const.done;
  498.  
  499.       begin
  500.          if typ=ait_const_symbol then
  501.            strdispose(pchar(value));
  502.          inherited done;
  503.       end;
  504.  
  505. {****************************************************************************
  506.                                TAI_DOUBLE
  507.  ****************************************************************************}
  508.  
  509.     constructor tai_double.init(_value : double);
  510.  
  511.       begin
  512.          inherited init;
  513.          typ:=ait_real_64bit;
  514.          value:=_value;
  515.       end;
  516.  
  517. {****************************************************************************
  518.                                TAI_SINGLE
  519.  ****************************************************************************}
  520.  
  521.     constructor tai_single.init(_value : single);
  522.  
  523.       begin
  524.          inherited init;
  525.          typ:=ait_real_32bit;
  526.          value:=_value;
  527.       end;
  528.  
  529. {****************************************************************************
  530.                                TAI_EXTENDED
  531.  ****************************************************************************}
  532.  
  533.     constructor tai_extended.init(_value : bestreal);
  534.  
  535.       begin
  536.          inherited init;
  537.          typ:=ait_real_extended;
  538.          value:=_value;
  539.       end;
  540.  
  541. {****************************************************************************
  542.                                TAI_COMP
  543.  ****************************************************************************}
  544.  
  545.     constructor tai_comp.init(_value : bestreal);
  546.  
  547.       begin
  548.          inherited init;
  549.          typ:=ait_comp;
  550.          value:=_value;
  551.       end;
  552.  
  553. {****************************************************************************
  554.                                TAI_STRING
  555.  ****************************************************************************}
  556.  
  557.      constructor tai_string.init(const _str : string);
  558.  
  559.        begin
  560.           inherited init;
  561.           typ:=ait_string;
  562.           getmem(str,length(_str)+1);
  563.           strpcopy(str,_str);
  564.           len:=length(_str);
  565.        end;
  566.  
  567.      constructor tai_string.init_pchar(_str : pchar);
  568.  
  569.        begin
  570.           inherited init;
  571.           typ:=ait_string;
  572.           str:=_str;
  573.           len:=strlen(_str);
  574.        end;
  575.  
  576.     destructor tai_string.done;
  577.  
  578.       begin
  579.          { you can have #0 inside the strings so }
  580.          if str<>nil then
  581.            freemem(str,len+1);
  582.          inherited done;
  583.       end;
  584.  
  585. {****************************************************************************
  586.                                TAI_LABEL
  587.  ****************************************************************************}
  588.  
  589.      constructor tai_label.init(_l : plabel);
  590.  
  591.        begin
  592.           inherited init;
  593.           typ:=ait_label;
  594.           l:=_l;
  595.           l^.is_set:=true;
  596.           { suggestion of JM:
  597.             inc(l^.refcount); }
  598.        end;
  599.  
  600.     destructor tai_label.done;
  601.  
  602.       begin
  603.          { suggestion of JM:
  604.          dec(l^.refcount);  }
  605.          if (l^.is_used) then
  606.            l^.is_set:=false
  607.          else dispose(l);
  608.          inherited done;
  609.       end;
  610.  
  611. {****************************************************************************
  612.                               TAI_DIRECT
  613.  ****************************************************************************}
  614.  
  615.      constructor tai_direct.init(_str : pchar);
  616.  
  617.        begin
  618.           inherited init;
  619.           typ:=ait_direct;
  620.           str:=_str;
  621.        end;
  622.  
  623.     destructor tai_direct.done;
  624.  
  625.       begin
  626.          strdispose(str);
  627.          inherited done;
  628.       end;
  629.  
  630. {****************************************************************************
  631.                               TAI_ALIGN
  632.  ****************************************************************************}
  633.  
  634.      constructor tai_align.init(b: byte);
  635.  
  636.        begin
  637.           inherited init;
  638.           typ:=ait_align;
  639.           if b in [1,2,4,8,16] then
  640.            aligntype := b
  641.           else
  642.            aligntype := 1;
  643.           op:=0;
  644.        end;
  645.  
  646.  
  647.      constructor tai_align.init_op(b: byte; use_op: byte);
  648.  
  649.        begin
  650.           inherited init;
  651.           typ:=ait_align;
  652.           if b in [1,2,4,8,16] then
  653.            aligntype := b
  654.           else
  655.            aligntype := 1;
  656.            op:=use_op;
  657.        end;
  658.  
  659.     destructor tai_align.done;
  660.  
  661.       begin
  662.          inherited done;
  663.       end;
  664.  
  665. {$ifdef MAKELIB}
  666. {****************************************************************************
  667.                               TAI_CUT
  668.  ****************************************************************************}
  669.  
  670.      constructor tai_cut.init;
  671.  
  672.        begin
  673.           inherited init;
  674.           typ:=ait_cut;
  675.        end;
  676. {$endif MAKELIB}
  677.  
  678. end.
  679. {
  680.   $Log: aasm.pas,v $
  681.   Revision 1.1.1.1  1998/03/25 11:18:16  root
  682.   * Restored version
  683.  
  684.   Revision 1.18  1998/03/10 16:27:36  pierre
  685.     * better line info in stabs debug
  686.     * symtabletype and lexlevel separated into two fields of tsymtable
  687.     + ifdef MAKELIB for direct library output, not complete
  688.     + ifdef CHAINPROCSYMS for overloaded seach across units, not fully
  689.       working
  690.     + ifdef TESTFUNCRET for setting func result in underfunction, not
  691.       working
  692.  
  693.   Revision 1.17  1998/03/10 01:17:13  peter
  694.     * all files have the same header
  695.     * messages are fully implemented, EXTDEBUG uses Comment()
  696.     + AG... files for the Assembler generation
  697.  
  698.   Revision 1.16  1998/03/02 01:47:56  peter
  699.     * renamed target_DOS to target_GO32V1
  700.     + new verbose system, merged old errors and verbose units into one new
  701.       verbose.pas, so errors.pas is obsolete
  702.  
  703.   Revision 1.15  1998/02/28 14:43:46  florian
  704.     * final implemenation of win32 imports
  705.     * extended tai_align to allow 8 and 16 byte aligns
  706.  
  707.   Revision 1.14  1998/02/28 00:20:20  florian
  708.     * more changes to get import libs for Win32 working
  709.  
  710.   Revision 1.13  1998/02/27 22:27:50  florian
  711.     + win_targ unit
  712.     + support of sections
  713.     + new asmlists: sections, exports and resource
  714.  
  715.   Revision 1.12  1998/02/24 00:19:08  peter
  716.     * makefile works again (btw. linux does like any char after a \ )
  717.     * removed circular unit with assemble and files
  718.     * fixed a sigsegv in pexpr
  719.     * pmodule init unit/program is the almost the same, merged them
  720.  
  721.   Revision 1.11  1998/02/13 10:34:29  daniel
  722.   * Made Motorola version compilable.
  723.   * Fixed optimizer
  724.  
  725.   Revision 1.10  1998/02/06 23:08:31  florian
  726.     + endian to targetinfo and sourceinfo added
  727.     + endian independed writing of ppu file (reading missed), a PPU file
  728.       is written with the target endian
  729.  
  730.   Revision 1.9  1998/01/11 04:14:30  carl
  731.   + correct floating point support for m68k
  732.  
  733.   Revision 1.6  1997/12/09 13:18:34  carl
  734.   + added pai_align abstract object (required for m68k)
  735.   + renamed ait_real_s80bit --> ait_real_extended
  736.  
  737.   Revision 1.5  1997/12/01 18:14:32  pierre
  738.       * fixes a bug in nasm output due to my previous changes
  739.  
  740.   Revision 1.3  1997/11/28 18:14:17  pierre
  741.    working version with several bug fixes
  742.  
  743.   Revision 1.2  1997/11/28 14:26:18  florian
  744.   Fixed some bugs
  745.  
  746.   Revision 1.1.1.1  1997/11/27 08:32:50  michael
  747.   FPC Compiler CVS start
  748.  
  749.   Pre-CVS log:
  750.  
  751.   FK     Florian Klaempfl
  752.   PM     Pierre Muller
  753.   +      feature added
  754.   -      removed
  755.   *      bug fixed or changed
  756.  
  757.   History:
  758.       30th september 1996:
  759.          + unit started
  760.       13th november 1997:
  761.          + added pai_single and pai_extended (PM)
  762.       14th november 1997:
  763.          + added bestreal type and pai_bestreal
  764.            to store all real consts with best precision (PM)
  765.            has a drawback for GDB that does not know extended !! (PM)
  766.  
  767. }
  768.