+ moved target_cpu_string to cpuinfo

  * renamed asmmode enum.
  * assembler reader has now less ifdef's
  * move from nppcmem.pas -> ncgmem.pas vec. node.

compiler/globals.pas

@@ -51,7 +51,7 @@ interface
       dos,
 {$endif}
       cutils,cclasses,
-      globtype,version,systems;
+      globtype,version,systems,cpuinfo;
 
     const
 {$ifdef Splitheap}
@@ -1450,7 +1450,7 @@ implementation
         {$IFDEF testvarsets}
          initsetalloc:=0;
         {$ENDIF}
-        initasmmode:=asmmode_ppc_direct;
+        initasmmode:=asmmode_direct;
 {$endif powerpc}
         initinterfacetype:=it_interfacecom;
         initdefproccall:=pocall_none;
@@ -1480,7 +1480,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.62  2002-07-28 20:45:22  florian
+  Revision 1.63  2002-08-10 14:46:29  carl
+    + moved target_cpu_string to cpuinfo
+    * renamed asmmode enum.
+    * assembler reader has now less ifdef's
+    * move from nppcmem.pas -> ncgmem.pas vec. node.
+
+  Revision 1.62  2002/07/28 20:45:22  florian
     + added direct assembler reader for PowerPC
 
   Revision 1.61  2002/07/20 17:12:42  florian

compiler/i386/cpuinfo.pas

@@ -46,12 +46,22 @@ Const
    {# Size of a multimedia register               }
    mmreg_size = 8;
 
+   { target cpu string (used by compiler options) }
+   target_cpu_string = 'i386';
+   
+
 Implementation
 
 end.
 {
   $Log$
-  Revision 1.10  2002-05-18 13:34:22  peter
+  Revision 1.11  2002-08-10 14:47:50  carl
+    + moved target_cpu_string to cpuinfo
+    * renamed asmmode enum.
+    * assembler reader has now less ifdef's
+    * move from nppcmem.pas -> ncgmem.pas vec. node.
+
+  Revision 1.10  2002/05/18 13:34:22  peter
     * readded missing revisions
 
   Revision 1.9  2002/05/16 19:46:50  carl

compiler/i386/cpuswtch.pas

@@ -114,7 +114,7 @@ begin
              initasmmode:=asmmode_i386_intel
            else
             if More='DIRECT' then
-             initasmmode:=asmmode_i386_direct
+             initasmmode:=asmmode_direct
            else
             IllegalPara(opt);
          end;
@@ -129,7 +129,13 @@ initialization
 end.
 {
   $Log$
-  Revision 1.7  2002-05-18 13:34:22  peter
+  Revision 1.8  2002-08-10 14:47:50  carl
+    + moved target_cpu_string to cpuinfo
+    * renamed asmmode enum.
+    * assembler reader has now less ifdef's
+    * move from nppcmem.pas -> ncgmem.pas vec. node.
+
+  Revision 1.7  2002/05/18 13:34:22  peter
     * readded missing revisions
 
   Revision 1.6  2002/05/16 19:46:50  carl

compiler/i386/ra386dir.pas → compiler/i386/radirect.pas

@@ -20,7 +20,7 @@
 
  ****************************************************************************
 }
-unit Ra386dir;
+unit radirect;
 
 {$i fpcdefs.inc}
 
@@ -294,7 +294,7 @@ interface
 const
   asmmode_i386_direct_info : tasmmodeinfo =
           (
-            id    : asmmode_i386_direct;
+            id    : asmmode_direct;
             idtxt : 'DIRECT'
           );
 
@@ -304,7 +304,13 @@ initialization
 end.
 {
   $Log$
-  Revision 1.21  2002-07-20 11:58:05  florian
+  Revision 1.1  2002-08-10 14:47:50  carl
+    + moved target_cpu_string to cpuinfo
+    * renamed asmmode enum.
+    * assembler reader has now less ifdef's
+    * move from nppcmem.pas -> ncgmem.pas vec. node.
+
+  Revision 1.21  2002/07/20 11:58:05  florian
     * types.pas renamed to defbase.pas because D6 contains a types
       unit so this would conflicts if D6 programms are compiled
     + Willamette/SSE2 instructions to assembler added

compiler/ia64/cpuinfo.pas

@@ -43,13 +43,22 @@ Const
    c_countusableregsfpu = 95;
    c_countusableregsmm  = 0;
    c_countusableregsqp  = 48;
+   
+   { target cpu string (used by compiler options) }
+   target_cpu_string = 'ia64';
 
 Implementation
 
 end.
 {
   $Log$
-  Revision 1.4  2002-05-16 19:46:52  carl
+  Revision 1.5  2002-08-10 14:48:09  carl
+    + moved target_cpu_string to cpuinfo
+    * renamed asmmode enum.
+    * assembler reader has now less ifdef's
+    * move from nppcmem.pas -> ncgmem.pas vec. node.
+
+  Revision 1.4  2002/05/16 19:46:52  carl
   + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
   + try to fix temp allocation (still in ifdef)
   + generic constructor calls

compiler/ncgmem.pas

@@ -79,25 +79,27 @@ interface
 implementation
 
     uses
+{$ifdef delphi}
+      sysutils,
+{$endif}
       globtype,systems,
       cutils,verbose,globals,
-      symconst,symdef,symsym,paramgr,
+      symconst,symtype,symdef,symsym,symtable,defbase,paramgr,
       aasmbase,aasmtai,aasmcpu,
-      cgbase,pass_2,
-      nld,ncon,nadd,
-      cpubase,cpupara,
-      cgobj,cgcpu,
-      tgobj,rgobj
+      cginfo,cgbase,pass_2,
+      pass_1,nld,ncon,nadd,
+      cpubase,
+      cgobj,tgobj,rgobj,ncgutil,symbase,
 {$ifdef GDB}
   {$ifdef delphi}
-      ,sysutils
+      sysutils,
   {$else}
-      ,strings
+      strings,
   {$endif}
-      ,symbase
-      ,gdb
+      gdb
 {$endif GDB}
       ;
+      
 
 {*****************************************************************************
                             TCGLOADNODE
@@ -486,11 +488,382 @@ implementation
        begin
        end;
 
-     procedure tcgvecnode.pass_2;
-       begin
-          {!!!!}
-          writeln('FIX ME: tcgvecnode.pass_2');
-       end;
+    procedure tcgvecnode.pass_2;
+
+      var
+         extraoffset : longint;
+         { rl stores the resulttype.def of the left node, this is necessary }
+         { to detect if it is an ansistring                          }
+         { because in constant nodes which constant index              }
+         { the left tree is removed                                  }
+         t   : tnode;
+         href : treference;
+         srsym : tsym;
+         pushed : tpushedsaved;
+         hightree : tnode;
+         isjump  : boolean;
+         otl,ofl : tasmlabel;
+         newsize : tcgsize;
+         pushedregs : tmaybesave;
+      begin
+         newsize:=def_cgsize(resulttype.def);
+         location_reset(location,LOC_REFERENCE,newsize);
+
+         secondpass(left);
+         { we load the array reference to location }
+
+         { an ansistring needs to be dereferenced }
+         if is_ansistring(left.resulttype.def) or
+            is_widestring(left.resulttype.def) then
+           begin
+              if nf_callunique in flags then
+                begin
+                   if left.location.loc<>LOC_REFERENCE then
+                     begin
+                        CGMessage(cg_e_illegal_expression);
+                        exit;
+                     end;
+                   rg.saveusedregisters(exprasmlist,pushed,all_registers);
+                   cg.a_paramaddr_ref(exprasmlist,left.location.reference,paramanager.getintparaloc(1));
+                   rg.saveregvars(exprasmlist,all_registers);
+                   cg.a_call_name(exprasmlist,'FPC_'+Upper(tstringdef(left.resulttype.def).stringtypname)+'_UNIQUE');
+                   cg.g_maybe_loadself(exprasmlist);
+                   rg.restoreusedregisters(exprasmlist,pushed);
+                end;
+
+              case left.location.loc of
+                LOC_REGISTER,
+                LOC_CREGISTER :
+                  location.reference.base:=left.location.register;
+                LOC_CREFERENCE,
+                LOC_REFERENCE :
+                  begin
+                    location_release(exprasmlist,left.location);
+                    location.reference.base:=rg.getregisterint(exprasmlist);
+                    cg.a_load_ref_reg(exprasmlist,OS_ADDR,left.location.reference,location.reference.base);
+                  end;
+                else
+                  internalerror(2002032218);
+              end;
+
+              { check for a zero length string,
+                we can use the ansistring routine here }
+              if (cs_check_range in aktlocalswitches) then
+                begin
+                   rg.saveusedregisters(exprasmlist,pushed,all_registers);
+                   cg.a_param_reg(exprasmlist,OS_ADDR,location.reference.base,paramanager.getintparaloc(1));
+                   rg.saveregvars(exprasmlist,all_registers);
+                   cg.a_call_name(exprasmlist,'FPC_'+Upper(tstringdef(left.resulttype.def).stringtypname)+'_CHECKZERO');
+                   cg.g_maybe_loadself(exprasmlist);
+                   rg.restoreusedregisters(exprasmlist,pushed);
+                end;
+
+              { in ansistrings/widestrings S[1] is p<w>char(S)[0] !! }
+              if is_ansistring(left.resulttype.def) then
+                dec(location.reference.offset)
+              else
+                dec(location.reference.offset,2);
+
+              { we've also to keep left up-to-date, because it is used   }
+              { if a constant array index occurs, subject to change (FK) }
+              location_copy(left.location,location);
+           end
+         else if is_dynamic_array(left.resulttype.def) then
+         { ... also a dynamic string }
+           begin
+              case left.location.loc of
+                LOC_REGISTER,
+                LOC_CREGISTER :
+                  location.reference.base:=left.location.register;
+                LOC_REFERENCE,
+                LOC_CREFERENCE :
+                  begin
+                     location_release(exprasmlist,left.location);
+                     location.reference.base:=rg.getaddressregister(exprasmlist);
+                     cg.a_load_ref_reg(exprasmlist,OS_ADDR,
+                      left.location.reference,location.reference.base);
+                  end;
+                else
+                  internalerror(2002032219);
+              end;
+
+{$warning FIXME}
+              { check for a zero length string,
+                we can use the ansistring routine here }
+              if (cs_check_range in aktlocalswitches) then
+                begin
+                   rg.saveusedregisters(exprasmlist,pushed,all_registers);
+                   cg.a_param_reg(exprasmlist,OS_ADDR,location.reference.base,paramanager.getintparaloc(1));
+                   rg.saveregvars(exprasmlist,all_registers);
+                   cg.a_call_name(exprasmlist,'FPC_ANSISTR_CHECKZERO');
+                   cg.g_maybe_loadself(exprasmlist);
+                   rg.restoreusedregisters(exprasmlist,pushed);
+                end;
+
+              { we've also to keep left up-to-date, because it is used   }
+              { if a constant array index occurs, subject to change (FK) }
+              location_copy(left.location,location);
+           end
+         else
+           location_copy(location,left.location);
+
+         { offset can only differ from 0 if arraydef }
+         if (left.resulttype.def.deftype=arraydef) and
+           not(is_dynamic_array(left.resulttype.def)) then
+           dec(location.reference.offset,
+               get_mul_size*tarraydef(left.resulttype.def).lowrange);
+         if right.nodetype=ordconstn then
+           begin
+              { offset can only differ from 0 if arraydef }
+              if (left.resulttype.def.deftype=arraydef) then
+                begin
+                   if not(is_open_array(left.resulttype.def)) and
+                      not(is_array_of_const(left.resulttype.def)) and
+                      not(is_dynamic_array(left.resulttype.def)) then
+                     begin
+                        if (tordconstnode(right).value>tarraydef(left.resulttype.def).highrange) or
+                           (tordconstnode(right).value<tarraydef(left.resulttype.def).lowrange) then
+                           begin
+                          { this should be caught in the resulttypepass! (JM) }
+                              if (cs_check_range in aktlocalswitches) then
+                                CGMessage(parser_e_range_check_error)
+                              else
+                                CGMessage(parser_w_range_check_error);
+                           end;
+                        dec(left.location.reference.offset,
+                            get_mul_size*tarraydef(left.resulttype.def).lowrange);
+                     end
+                   else
+                     begin
+                        { range checking for open and dynamic arrays !!!! }
+{$warning FIXME}
+                        {!!!!!!!!!!!!!!!!!}
+                     end;
+                end
+              else if (left.resulttype.def.deftype=stringdef) then
+                begin
+                   if (tordconstnode(right).value=0) and
+                      not(is_shortstring(left.resulttype.def)) then
+                    { this should be caught in the resulttypepass! (JM) }
+                     CGMessage(cg_e_can_access_element_zero);
+
+                   if (cs_check_range in aktlocalswitches) then
+                    begin
+                      case tstringdef(left.resulttype.def).string_typ of
+                        { it's the same for ansi- and wide strings }
+                        st_widestring,
+                        st_ansistring:
+                          begin
+                             rg.saveusedregisters(exprasmlist,pushed,all_registers);
+                             cg.a_param_const(exprasmlist,OS_INT,tordconstnode(right).value,paramanager.getintparaloc(2));
+                             href:=location.reference;
+                             dec(href.offset,7);
+                             cg.a_param_ref(exprasmlist,OS_INT,href,paramanager.getintparaloc(1));
+                             rg.saveregvars(exprasmlist,all_registers);
+                             cg.a_call_name(exprasmlist,'FPC_'+Upper(tstringdef(left.resulttype.def).stringtypname)+'_RANGECHECK');
+                             rg.restoreusedregisters(exprasmlist,pushed);
+                             cg.g_maybe_loadself(exprasmlist);
+                          end;
+
+                        st_shortstring:
+                          begin
+                             {!!!!!!!!!!!!!!!!!}
+                          end;
+
+                        st_longstring:
+                          begin
+                             {!!!!!!!!!!!!!!!!!}
+                          end;
+                      end;
+                    end;
+                end;
+              inc(left.location.reference.offset,
+                  get_mul_size*tordconstnode(right).value);
+
+              location_copy(location,left.location);
+           end
+         else
+         { not nodetype=ordconstn }
+           begin
+              if (cs_regalloc in aktglobalswitches) and
+                 { if we do range checking, we don't }
+                 { need that fancy code (it would be }
+                 { buggy)                            }
+                 not(cs_check_range in aktlocalswitches) and
+                 (left.resulttype.def.deftype=arraydef) then
+                begin
+                   extraoffset:=0;
+                   if (right.nodetype=addn) then
+                     begin
+                        if taddnode(right).right.nodetype=ordconstn then
+                          begin
+                             extraoffset:=tordconstnode(taddnode(right).right).value;
+                             t:=taddnode(right).left;
+                             { First pass processed this with the assumption   }
+                             { that there was an add node which may require an }
+                             { extra register. Fake it or die with IE10 (JM)   }
+                             t.registers32 := taddnode(right).registers32;
+                             taddnode(right).left:=nil;
+                             right.free;
+                             right:=t;
+                          end
+                        else if taddnode(right).left.nodetype=ordconstn then
+                          begin
+                             extraoffset:=tordconstnode(taddnode(right).left).value;
+                             t:=taddnode(right).right;
+                             t.registers32 :=  right.registers32;
+                             taddnode(right).right:=nil;
+                             right.free;
+                             right:=t;
+                          end;
+                     end
+                   else if (right.nodetype=subn) then
+                     begin
+                        if taddnode(right).right.nodetype=ordconstn then
+                          begin
+{ this was "extraoffset:=right.right.value;" Looks a bit like
+  copy-paste bug :) (JM) }
+                             extraoffset:=-tordconstnode(taddnode(right).right).value;
+                             t:=taddnode(right).left;
+                             t.registers32 :=  right.registers32;
+                             taddnode(right).left:=nil;
+                             right.free;
+                             right:=t;
+                          end
+{ You also have to negate right.right in this case! I can't add an
+  unaryminusn without causing a crash, so I've disabled it (JM)
+                        else if right.left.nodetype=ordconstn then
+                          begin
+                             extraoffset:=right.left.value;
+                             t:=right.right;
+                             t^.registers32 :=  right.registers32;
+                             putnode(right);
+                             putnode(right.left);
+                             right:=t;
+                         end;}
+                     end;
+                   inc(location.reference.offset,
+                       get_mul_size*extraoffset);
+                end;
+              { calculate from left to right }
+              if not(location.loc in [LOC_CREFERENCE,LOC_REFERENCE]) then
+                { should be internalerror! (JM) }
+                CGMessage(cg_e_illegal_expression);
+              isjump:=(right.location.loc=LOC_JUMP);
+              if isjump then
+               begin
+                 otl:=truelabel;
+                 getlabel(truelabel);
+                 ofl:=falselabel;
+                 getlabel(falselabel);
+               end;
+              maybe_save(exprasmlist,right.registers32,location,pushedregs);
+              secondpass(right);
+              maybe_restore(exprasmlist,location,pushedregs);
+              { here we change the location of right
+                and the update was forgotten so it
+                led to wrong code in emitrangecheck later PM
+                so make range check before }
+
+              if cs_check_range in aktlocalswitches then
+               begin
+                 if left.resulttype.def.deftype=arraydef then
+                   begin
+                     if is_open_array(left.resulttype.def) or
+                        is_array_of_const(left.resulttype.def) then
+                      begin
+                        tarraydef(left.resulttype.def).genrangecheck;
+                        srsym:=searchsymonlyin(tloadnode(left).symtable,
+                          'high'+tvarsym(tloadnode(left).symtableentry).name);
+                        hightree:=cloadnode.create(tvarsym(srsym),tloadnode(left).symtable);
+                        firstpass(hightree);
+                        secondpass(hightree);
+                        location_release(exprasmlist,hightree.location);
+                        reference_reset_symbol(href,newasmsymbol(tarraydef(left.resulttype.def).getrangecheckstring),4);
+                        cg.a_load_loc_ref(exprasmlist,hightree.location,href);
+                        hightree.free;
+                        hightree:=nil;
+                      end;
+                     cg.g_rangecheck(exprasmlist,right,left.resulttype.def);
+                   end;
+               end;
+
+              location_force_reg(exprasmlist,right.location,OS_32,false);
+
+              if isjump then
+               begin
+                 truelabel:=otl;
+                 falselabel:=ofl;
+               end;
+
+            { produce possible range check code: }
+              if cs_check_range in aktlocalswitches then
+               begin
+                 if left.resulttype.def.deftype=arraydef then
+                   begin
+                     { done defore (PM) }
+                   end
+                 else if (left.resulttype.def.deftype=stringdef) then
+                   begin
+                      case tstringdef(left.resulttype.def).string_typ of
+                         { it's the same for ansi- and wide strings }
+                         st_widestring,
+                         st_ansistring:
+                           begin
+                              rg.saveusedregisters(exprasmlist,pushed,all_registers);
+                              cg.a_param_reg(exprasmlist,OS_INT,right.location.register,paramanager.getintparaloc(1));
+                              href:=location.reference;
+                              dec(href.offset,7);
+                              cg.a_param_ref(exprasmlist,OS_INT,href,paramanager.getintparaloc(1));
+                              rg.saveregvars(exprasmlist,all_registers);
+                              cg.a_call_name(exprasmlist,'FPC_'+Upper(tstringdef(left.resulttype.def).stringtypname)+'_RANGECHECK');
+                              rg.restoreusedregisters(exprasmlist,pushed);
+                              cg.g_maybe_loadself(exprasmlist);
+                           end;
+                         st_shortstring:
+                           begin
+                              {!!!!!!!!!!!!!!!!!}
+                           end;
+                         st_longstring:
+                           begin
+                              {!!!!!!!!!!!!!!!!!}
+                           end;
+                      end;
+                   end;
+               end;
+
+              if location.reference.index=R_NO then
+               begin
+                 location.reference.index:=right.location.register;
+                 cg.a_op_const_reg(exprasmlist,OP_IMUL,get_mul_size,
+                   right.location.register);
+               end
+              else
+               begin
+                 if location.reference.base=R_NO then
+                   { this wouldn't make sense for the ppc since there are }
+                   { no scalefactors (JM)                                 }
+                   internalerror(2002072901)
+                 else
+                  begin
+                    cg.a_loadaddr_ref_reg(exprasmlist,location.reference,
+                      location.reference.base);
+                    rg.ungetregisterint(exprasmlist,location.reference.index);
+                    { the symbol offset is loaded,             }
+                    { so release the symbol name and set symbol  }
+                    { to nil                                 }
+                    location.reference.symbol:=nil;
+                    location.reference.offset:=0;
+                    cg.a_op_const_reg(exprasmlist,OP_IMUL,
+                      get_mul_size,right.location.register);
+                    location.reference.index:=right.location.register;
+                  end;
+               end;
+
+           end;
+
+        location.size:=newsize;
+      end;
 
 
 begin
@@ -507,7 +880,13 @@ begin
 end.
 {
   $Log$
-  Revision 1.18  2002-07-28 21:34:31  florian
+  Revision 1.19  2002-08-10 14:46:29  carl
+    + moved target_cpu_string to cpuinfo
+    * renamed asmmode enum.
+    * assembler reader has now less ifdef's
+    * move from nppcmem.pas -> ncgmem.pas vec. node.
+
+  Revision 1.18  2002/07/28 21:34:31  florian
     * more powerpc fixes
     + dummy tcgvecnode
 

compiler/options.pas

@@ -27,7 +27,7 @@ unit options;
 interface
 
 uses
-  globtype,globals,verbose,systems;
+  globtype,globals,verbose,systems,cpuinfo;
 
 type
   TOption=class
@@ -1677,7 +1677,13 @@ finalization
 end.
 {
   $Log$
-  Revision 1.80  2002-08-09 19:15:41  carl
+  Revision 1.81  2002-08-10 14:46:29  carl
+    + moved target_cpu_string to cpuinfo
+    * renamed asmmode enum.
+    * assembler reader has now less ifdef's
+    * move from nppcmem.pas -> ncgmem.pas vec. node.
+
+  Revision 1.80  2002/08/09 19:15:41  carl
      - removed newcg define
 
   Revision 1.79  2002/07/26 22:22:10  florian

compiler/pmodules.pas

@@ -40,7 +40,7 @@ implementation
        globals,verbose,fmodule,finput,fppu,
        symconst,symbase,symtype,symdef,symsym,symtable,
        aasmbase,aasmtai,aasmcpu,
-       cgbase,
+       cgbase,cpuinfo,
        ncgutil,
        link,assemble,import,export,gendef,ppu,comprsrc,
        cresstr,cpubase,
@@ -1388,7 +1388,13 @@ implementation
 end.
 {
   $Log$
-  Revision 1.69  2002-07-26 21:15:41  florian
+  Revision 1.70  2002-08-10 14:46:29  carl
+    + moved target_cpu_string to cpuinfo
+    * renamed asmmode enum.
+    * assembler reader has now less ifdef's
+    * move from nppcmem.pas -> ncgmem.pas vec. node.
+
+  Revision 1.69  2002/07/26 21:15:41  florian
     * rewrote the system handling
 
   Revision 1.68  2002/07/04 20:43:01  florian

compiler/powerpc/cpuinfo.pas

@@ -38,13 +38,21 @@ Const
    pointer_size  = 4;
    {# Size of a multimedia register               }
    mmreg_size = 16;
+   { target cpu string (used by compiler options) }
+   target_cpu_string = 'powerpc';
 
 Implementation
 
 end.
 {
   $Log$
-  Revision 1.7  2002-05-18 13:34:26  peter
+  Revision 1.8  2002-08-10 14:52:52  carl
+    + moved target_cpu_string to cpuinfo
+    * renamed asmmode enum.
+    * assembler reader has now less ifdef's
+    * move from nppcmem.pas -> ncgmem.pas vec. node.
+
+  Revision 1.7  2002/05/18 13:34:26  peter
     * readded missing revisions
 
   Revision 1.6  2002/05/16 19:46:53  carl

compiler/powerpc/cpunode.pas

@@ -39,7 +39,7 @@ unit cpunode;
 //       nppccal,
 //       nppccon,
 //       nppcflw,
-       nppcmem,
+//       nppcmem,
 //       nppcset,
 //       nppcinl,
 //       nppcopt,
@@ -52,7 +52,13 @@ unit cpunode;
 end.
 {
   $Log$
-  Revision 1.11  2002-07-29 09:22:20  jonas
+  Revision 1.12  2002-08-10 14:52:52  carl
+    + moved target_cpu_string to cpuinfo
+    * renamed asmmode enum.
+    * assembler reader has now less ifdef's
+    * move from nppcmem.pas -> ncgmem.pas vec. node.
+
+  Revision 1.11  2002/07/29 09:22:20  jonas
     + nppcmem
 
   Revision 1.10  2002/07/28 20:45:22  florian

compiler/powerpc/cpuswtch.pas

@@ -112,7 +112,7 @@ begin
              initasmmode:=asmmode_ppc_motorola
            else
             if More='DIRECT' then
-             initasmmode:=asmmode_ppc_direct
+             initasmmode:=asmmode_direct
            else
             IllegalPara(opt);
          end;
@@ -128,7 +128,13 @@ initialization
 end.
 {
   $Log$
-  Revision 1.5  2002-07-28 20:45:23  florian
+  Revision 1.6  2002-08-10 14:52:52  carl
+    + moved target_cpu_string to cpuinfo
+    * renamed asmmode enum.
+    * assembler reader has now less ifdef's
+    * move from nppcmem.pas -> ncgmem.pas vec. node.
+
+  Revision 1.5  2002/07/28 20:45:23  florian
     + added direct assembler reader for PowerPC
 
   Revision 1.4  2002/05/18 13:34:26  peter

compiler/powerpc/radirect.pas

@@ -0,0 +1,331 @@
+{
+    $Id$
+    Copyright (c) 1998-2002 by Florian Klaempfl
+
+    Reads inline Powerpc assembler and writes the lines direct to the output
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+{
+  This unit reads PowerPC inline assembler and writes the lines direct to the output file.
+}
+unit radirect;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      node;
+
+     function assemble : tnode;
+
+  implementation
+
+    uses
+       { common }
+       cutils,
+       { global }
+       globals,verbose,
+       systems,
+       { aasm }
+       aasmbase,aasmtai,aasmcpu,
+       { symtable }
+       symconst,symbase,symtype,symsym,symtable,defbase,
+       { pass 1 }
+       nbas,
+       { parser }
+       scanner,
+       { codegen }
+       cgbase,
+       { constants }
+       agppcgas
+       ;
+
+    function assemble : tnode;
+
+      var
+         retstr,s,hs : string;
+         c : char;
+         ende : boolean;
+         srsym,sym : tsym;
+         srsymtable : tsymtable;
+         code : TAAsmoutput;
+         i,l : longint;
+
+       procedure writeasmline;
+         var
+           i : longint;
+         begin
+           i:=length(s);
+           while (i>0) and (s[i] in [' ',#9]) do
+            dec(i);
+           s[0]:=chr(i);
+           if s<>'' then
+            code.concat(Tai_direct.Create(strpnew(s)));
+            { consider it set function set if the offset was loaded }
+           if assigned(aktprocdef.funcretsym) and
+              (pos(retstr,upper(s))>0) then
+             tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
+           s:='';
+         end;
+
+     begin
+       ende:=false;
+       s:='';
+       if assigned(aktprocdef.funcretsym) and
+          is_fpu(aktprocdef.rettype.def) then
+         tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
+       { !!!!!
+       if (not is_void(aktprocdef.rettype.def)) then
+         retstr:=upper(tostr(procinfo^.return_offset)+'('+gas_reg2str[procinfo^.framepointer]+')')
+       else
+       }
+         retstr:='';
+
+       c:=current_scanner.asmgetchar;
+       code:=TAAsmoutput.Create;
+       while not(ende) do
+         begin
+            { wrong placement
+            current_scanner.gettokenpos; }
+            case c of
+              'A'..'Z','a'..'z','_':
+                begin
+                   current_scanner.gettokenpos;
+                   i:=0;
+                   hs:='';
+                   while ((ord(c)>=ord('A')) and (ord(c)<=ord('Z')))
+                      or ((ord(c)>=ord('a')) and (ord(c)<=ord('z')))
+                      or ((ord(c)>=ord('0')) and (ord(c)<=ord('9')))
+                      or (c='_') do
+                     begin
+                        inc(i);
+                        hs[i]:=c;
+                        c:=current_scanner.asmgetchar;
+                     end;
+                   hs[0]:=chr(i);
+                   if upper(hs)='END' then
+                      ende:=true
+                   else
+                      begin
+                         if c=':' then
+                           begin
+                             searchsym(upper(hs),srsym,srsymtable);
+                             if srsym<>nil then
+                               if (srsym.typ = labelsym) then
+                                 Begin
+                                    hs:=tlabelsym(srsym).lab.name;
+                                    tlabelsym(srsym).lab.is_set:=true;
+                                 end
+                               else
+                                 Message(asmr_w_using_defined_as_local);
+                           end;
+{$ifdef dummy}
+                         else
+                           { access to local variables }
+                           if assigned(aktprocdef) then
+                             begin
+                                { I don't know yet, what the ppc port requires }
+                                { we'll see how things settle down             }
+
+                                { is the last written character an special }
+                                { char ?                                   }
+                                if (s[length(s)]='%') and
+                                   ret_in_acc(aktprocdef.rettype.def) and
+                                   ((pos('AX',upper(hs))>0) or
+                                   (pos('AL',upper(hs))>0)) then
+                                  tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
+                                if (s[length(s)]<>'%') and
+                                  (s[length(s)]<>'$') and
+                                  ((s[length(s)]<>'0') or (hs[1]<>'x')) then
+                                  begin
+                                     if assigned(aktprocdef.localst) and
+                                        (lexlevel >= normal_function_level) then
+                                       sym:=tsym(aktprocdef.localst.search(upper(hs)))
+                                     else
+                                       sym:=nil;
+                                     if assigned(sym) then
+                                       begin
+                                          if (sym.typ = labelsym) then
+                                            Begin
+                                               hs:=tlabelsym(sym).lab.name;
+                                            end
+                                          else if sym.typ=varsym then
+                                            begin
+                                            {variables set are after a comma }
+                                            {like in movl %eax,I }
+                                            if pos(',',s) > 0 then
+                                              tvarsym(sym).varstate:=vs_used
+                                            else
+                                            if (pos('MOV',upper(s)) > 0) and (tvarsym(sym).varstate=vs_declared) then
+                                             Message1(sym_n_uninitialized_local_variable,hs);
+                                            if (vo_is_external in tvarsym(sym).varoptions) then
+                                              hs:=tvarsym(sym).mangledname
+                                            else
+                                              hs:='-'+tostr(tvarsym(sym).address)+
+                                                  '('+gas_reg2str[procinfo^.framepointer]+')';
+                                            end
+                                          else
+                                          { call to local function }
+                                          if (sym.typ=procsym) and ((pos('CALL',upper(s))>0) or
+                                             (pos('LEA',upper(s))>0)) then
+                                            begin
+                                               hs:=tprocsym(sym).defs^.def.mangledname;
+                                            end;
+                                       end
+                                     else
+                                       begin
+                                          if assigned(aktprocdef.parast) then
+                                            sym:=tsym(aktprocdef.parast.search(upper(hs)))
+                                          else
+                                            sym:=nil;
+                                          if assigned(sym) then
+                                            begin
+                                               if sym.typ=varsym then
+                                                 begin
+                                                    l:=tvarsym(sym).address;
+                                                    { set offset }
+                                                    inc(l,aktprocdef.parast.address_fixup);
+                                                    hs:=tostr(l)+'('+gas_reg2str[procinfo^.framepointer]+')';
+                                                    if pos(',',s) > 0 then
+                                                      tvarsym(sym).varstate:=vs_used;
+                                                 end;
+                                            end
+                                     { I added that but it creates a problem in line.ppi
+                                     because there is a local label wbuffer and
+                                     a static variable WBUFFER ...
+                                     what would you decide, florian ?}
+                                     else
+                                       begin
+                                          searchsym(upper(hs),sym,srsymtable);
+                                          if assigned(sym) and (sym.owner.symtabletype in [globalsymtable,staticsymtable]) then
+                                            begin
+                                              case sym.typ of
+                                                varsym :
+                                                  begin
+                                                    Message2(asmr_h_direct_global_to_mangled,hs,tvarsym(sym).mangledname);
+                                                    hs:=tvarsym(sym).mangledname;
+                                                    inc(tvarsym(sym).refs);
+                                                  end;
+                                                typedconstsym :
+                                                  begin
+                                                    Message2(asmr_h_direct_global_to_mangled,hs,ttypedconstsym(sym).mangledname);
+                                                    hs:=ttypedconstsym(sym).mangledname;
+                                                  end;
+                                                procsym :
+                                                  begin
+                                                    { procs can be called or the address can be loaded }
+                                                    if ((pos('CALL',upper(s))>0) or (pos('LEA',upper(s))>0)) then
+                                                     begin
+                                                       if assigned(tprocsym(sym).defs^.def) then
+                                                         Message1(asmr_w_direct_global_is_overloaded_func,hs);
+                                                       Message2(asmr_h_direct_global_to_mangled,hs,tprocsym(sym).defs^.def.mangledname);
+                                                       hs:=tprocsym(sym).defs^.def.mangledname;
+                                                     end;
+                                                  end;
+                                                else
+                                                  Message(asmr_e_wrong_sym_type);
+                                              end;
+                                            end
+                                          else if upper(hs)='__SELF' then
+                                            begin
+                                               if assigned(procinfo^._class) then
+                                                 hs:=tostr(procinfo^.selfpointer_offset)+
+                                                     '('+gas_reg2str[procinfo^.framepointer]+')'
+                                               else
+                                                Message(asmr_e_cannot_use_SELF_outside_a_method);
+                                            end
+                                          else if upper(hs)='__RESULT' then
+                                            begin
+                                               if (not is_void(aktprocdef.rettype.def)) then
+                                                 hs:=retstr
+                                               else
+                                                 Message(asmr_e_void_function);
+                                            end
+                                          { implement old stack/frame pointer access for nested procedures }
+                                          {!!!!
+                                          else if upper(hs)='__OLDSP' then
+                                            begin
+                                               { complicate to check there }
+                                               { we do it: }
+                                               if lexlevel>normal_function_level then
+                                                 hs:=tostr(procinfo^.framepointer_offset)+
+                                                   '('+gas_reg2str[procinfo^.framepointer]+')'
+                                               else
+                                                 Message(asmr_e_cannot_use_OLDEBP_outside_nested_procedure);
+                                            end;
+                                          }
+                                          end;
+                                       end;
+                                  end;
+                             end;
+{$endif dummy}
+                         s:=s+hs;
+                      end;
+                 end;
+              '{',';',#10,#13:
+                begin
+                   if pos(retstr,s) > 0 then
+                     tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
+                   writeasmline;
+                   c:=current_scanner.asmgetchar;
+                end;
+              #26:
+                Message(scan_f_end_of_file);
+              else
+                begin
+                  current_scanner.gettokenpos;
+                  inc(byte(s[0]));
+                  s[length(s)]:=c;
+                  c:=current_scanner.asmgetchar;
+                end;
+            end;
+         end;
+       writeasmline;
+       assemble:=casmnode.create(code);
+     end;
+
+{*****************************************************************************
+                                     Initialize
+*****************************************************************************}
+
+const
+  asmmode_ppc_direct_info : tasmmodeinfo =
+          (
+            id    : asmmode_direct;
+            idtxt : 'DIRECT'
+          );
+
+initialization
+  RegisterAsmMode(asmmode_ppc_direct_info);
+
+end.
+{
+  $Log$
+  Revision 1.1  2002-08-10 14:52:52  carl
+    + moved target_cpu_string to cpuinfo
+    * renamed asmmode enum.
+    * assembler reader has now less ifdef's
+    * move from nppcmem.pas -> ncgmem.pas vec. node.
+
+  Revision 1.2  2002/07/28 20:45:23  florian
+    + added direct assembler reader for PowerPC
+
+  Revision 1.1  2002/07/11 14:41:34  florian
+    * start of the new generic parameter handling
+}

compiler/powerpc/rappc.pas

@@ -20,7 +20,7 @@
 
  ****************************************************************************
 }
-unit Ra386;
+unit Rasm;
 
 {$i fpcdefs.inc}
 
@@ -669,7 +669,13 @@ end;
 end.
 {
   $Log$
-  Revision 1.1  2002-07-28 20:45:23  florian
+  Revision 1.2  2002-08-10 14:52:52  carl
+    + moved target_cpu_string to cpuinfo
+    * renamed asmmode enum.
+    * assembler reader has now less ifdef's
+    * move from nppcmem.pas -> ncgmem.pas vec. node.
+
+  Revision 1.1  2002/07/28 20:45:23  florian
     + added direct assembler reader for PowerPC
 
 }

compiler/powerpc/rasm.pas

@@ -0,0 +1,73 @@
+{
+    $Id$
+    Copyright (c) 1998-2002 by The Free Pascal Team
+
+    This unit does the parsing process for the inline assembler
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+
+Unit Rasm;
+
+{$i fpcdefs.inc}
+
+Interface
+
+uses
+  node;
+
+   { 
+     This routine is called to parse the instructions in assembler
+     blocks. It returns a complete list of directive and instructions
+   }  
+   function assemble: tnode;
+
+
+Implementation
+
+    uses
+       { common }
+       cutils,cclasses,
+       { global }
+       globtype,globals,verbose,
+       systems,
+       { aasm }
+       cpubase,aasmbase,aasmtai,aasmcpu,
+       { symtable }
+       symconst,symbase,symtype,symsym,symtable,
+       { pass 1 }
+       nbas,
+       { parser }
+       scanner,
+       rautils
+       ;
+
+    function assemble : tnode;
+     begin
+     end;
+     
+Begin
+end.
+{
+  $Log$
+  Revision 1.1  2002-08-10 14:52:52  carl
+    + moved target_cpu_string to cpuinfo
+    * renamed asmmode enum.
+    * assembler reader has now less ifdef's
+    * move from nppcmem.pas -> ncgmem.pas vec. node.
+
+}  

compiler/pstatmnt.pas

@@ -55,6 +55,7 @@ implementation
        pbase,pexpr,
        { codegen }
        rgobj,cgbase
+       ,radirect
 {$ifdef i386}
   {$ifndef NoRa386Int}
        ,ra386int
@@ -62,25 +63,9 @@ implementation
   {$ifndef NoRa386Att}
        ,ra386att
   {$endif NoRa386Att}
-  {$ifndef NoRa386Dir}
-       ,ra386dir
-  {$endif NoRa386Dir}
+{$else}  
+       ,rasm
 {$endif i386}
-{$ifdef powerpc}
-  {$ifndef NoRaPPCDir}
-       ,rappcdir
-  {$endif NoRaPPCDir}
-{$endif powerpc}
-{$ifdef x86_64}
-  {$ifndef NoRax86Dir}
-       ,rax86dir
-  {$endif NoRax86Dir}
-{$endif i386}
-{$ifdef m68k}
-  {$ifndef NoRa68kMot}
-       ,ra68kmot
-  {$endif NoRa68kMot}
-{$endif m68k}
        ;
 
 
@@ -740,25 +725,8 @@ implementation
            asmmode_i386_intel:
              asmstat:=tasmnode(ra386int.assemble);
   {$endif NoRA386Int}
-  {$ifndef NoRA386Dir}
-           asmmode_i386_direct:
-             begin
-               if not target_asm.allowdirect then
-                 Message(parser_f_direct_assembler_not_allowed);
-               if (aktprocdef.proccalloption=pocall_inline) then
-                 Begin
-                    Message1(parser_w_not_supported_for_inline,'direct asm');
-                    Message(parser_w_inlining_disabled);
-                    aktprocdef.proccalloption:=pocall_fpccall;
-                 End;
-               asmstat:=tasmnode(ra386dir.assemble);
-             end;
-  {$endif NoRA386Dir}
-{$endif}
-
-{$ifdef x86_64}
-  {$ifndef NoRA386Dir}
-           asmmode_i386_direct:
+{$else}  
+           asmmode_direct:
              begin
                if not target_asm.allowdirect then
                  Message(parser_f_direct_assembler_not_allowed);
@@ -768,34 +736,13 @@ implementation
                     Message(parser_w_inlining_disabled);
                     aktprocdef.proccalloption:=pocall_fpccall;
                  End;
-               asmstat:=tasmnode(rax86dir.assemble);
+               asmstat:=tasmnode(radirect.assemble);
              end;
-  {$endif NoRA386Dir}
-{$endif x86_64}
 
-{$ifdef powerpc}
-  {$ifndef NoRAPPCDir}
-           asmmode_ppc_direct:
-             begin
-               if not target_asm.allowdirect then
-                 Message(parser_f_direct_assembler_not_allowed);
-               if (aktprocdef.proccalloption=pocall_inline) then
-                 Begin
-                    Message1(parser_w_not_supported_for_inline,'direct asm');
-                    Message(parser_w_inlining_disabled);
-                    aktprocdef.proccalloption:=pocall_fpccall;
-                 End;
-               asmstat:=tasmnode(rappcdir.assemble);
-             end;
-  {$endif NoRAPPCDir}
-{$endif powerpc}
-
-{$ifdef m68k}
-  {$ifndef NoRA68kMot}
-           asmmode_m68k_mot:
-             asmstat:=tasmnode(ra68kmot.assemble);
-  {$endif NoRA68kMot}
-{$endif}
+           asmmode_standard:
+             asmstat:=tasmnode(rasm.assemble);
+{$endif}  
+             
          else
            Message(parser_f_assembler_reader_not_supported);
          end;
@@ -1195,7 +1142,13 @@ implementation
 end.
 {
   $Log$
-  Revision 1.67  2002-08-09 19:11:44  carl
+  Revision 1.68  2002-08-10 14:46:30  carl
+    + moved target_cpu_string to cpuinfo
+    * renamed asmmode enum.
+    * assembler reader has now less ifdef's
+    * move from nppcmem.pas -> ncgmem.pas vec. node.
+
+  Revision 1.67  2002/08/09 19:11:44  carl
     + reading of used registers in assembler routines is now
       cpu-independent
 

compiler/scanner.pas

@@ -31,7 +31,7 @@ interface
        globtype,globals,version,tokens,
        verbose,comphook,
        finput,
-       widestr;
+       widestr,cpuinfo;
 
     const
        maxmacrolen=16*1024;
@@ -2783,7 +2783,13 @@ exit_label:
 end.
 {
   $Log$
-  Revision 1.41  2002-08-06 21:12:16  florian
+  Revision 1.42  2002-08-10 14:46:31  carl
+    + moved target_cpu_string to cpuinfo
+    * renamed asmmode enum.
+    * assembler reader has now less ifdef's
+    * move from nppcmem.pas -> ncgmem.pas vec. node.
+
+  Revision 1.41  2002/08/06 21:12:16  florian
     + support for octal constants, they are specified by a leading &
 
   Revision 1.40  2002/07/20 17:35:52  florian

compiler/systems.pas

@@ -66,10 +66,12 @@ interface
        );
 
        tasmmode= (asmmode_none
-            ,asmmode_i386_direct,asmmode_i386_att,asmmode_i386_intel
-            ,asmmode_m68k_mot
-            ,asmmode_alpha_direct
-            ,asmmode_ppc_direct,asmmode_ppc_gas,asmmode_ppc_motorola
+            { direct output with minimal parsing }
+            ,asmmode_direct
+            { standard assembler (cpu dependant) with full parsing }
+            ,asmmode_standard
+            ,asmmode_i386_att
+            ,asmmode_i386_intel
        );
 
      { IMPORTANT NOTE:
@@ -636,7 +638,13 @@ finalization
 end.
 {
   $Log$
-  Revision 1.49  2002-07-28 20:45:22  florian
+  Revision 1.50  2002-08-10 14:46:31  carl
+    + moved target_cpu_string to cpuinfo
+    * renamed asmmode enum.
+    * assembler reader has now less ifdef's
+    * move from nppcmem.pas -> ncgmem.pas vec. node.
+
+  Revision 1.49  2002/07/28 20:45:22  florian
     + added direct assembler reader for PowerPC
 
   Revision 1.48  2002/07/26 21:15:42  florian

compiler/version.pas

@@ -43,35 +43,6 @@ interface
        date_string = 'N/A';
 {$endif}
 
-       { target cpu string }
-{$ifdef i386}
-       target_cpu_string = 'i386';
-{$endif}
-{$ifdef x86_64}
-       target_cpu_string = 'x86_64';
-{$endif}
-{$ifdef sparc}
-       target_cpu_string = 'sparc';
-{$endif}
-{$ifdef m68k}
-       target_cpu_string = 'm68k';
-{$endif}
-{$ifdef alpha}
-       target_cpu_string = 'alpha';
-{$endif}
-{$ifdef powerpc}
-       target_cpu_string = 'powerpc';
-{$endif}
-{$ifdef ia64}
-       target_cpu_string = 'ia64';
-{$endif}
-{$ifdef mips}
-       target_cpu_string = 'mips';
-{$endif}
-{$ifdef arm}
-       target_cpu_string = 'arm';
-{$endif}
-
 
        { source cpu string }
 {$ifdef cpu86}
@@ -113,7 +84,13 @@ end;
 end.
 {
   $Log$
-  Revision 1.14  2002-08-09 19:15:41  carl
+  Revision 1.15  2002-08-10 14:46:31  carl
+    + moved target_cpu_string to cpuinfo
+    * renamed asmmode enum.
+    * assembler reader has now less ifdef's
+    * move from nppcmem.pas -> ncgmem.pas vec. node.
+
+  Revision 1.14  2002/08/09 19:15:41  carl
      - removed newcg define
 
   Revision 1.13  2002/07/04 20:43:02  florian

compiler/x86_64/cpuinfo.pas

@@ -49,6 +49,8 @@ Const
    pointer_size  = 8;
    { Size of a multimedia register }
    mmreg_size = 16;
+   { target cpu string (used by compiler options) }
+   target_cpu_string = 'x86_64';
 
 
 Implementation
@@ -56,7 +58,13 @@ Implementation
 end.
 {
   $Log$
-  Revision 1.2  2002-07-25 22:55:34  florian
+  Revision 1.3  2002-08-10 14:53:38  carl
+    + moved target_cpu_string to cpuinfo
+    * renamed asmmode enum.
+    * assembler reader has now less ifdef's
+    * move from nppcmem.pas -> ncgmem.pas vec. node.
+
+  Revision 1.2  2002/07/25 22:55:34  florian
     * several fixes, small test units can be compiled
 
   Revision 1.1  2002/07/24 22:38:15  florian

compiler/x86_64/cpuswtch.pas

@@ -86,7 +86,7 @@ begin
              initasmmode:=asmmode_i386_intel
            else
             if More='DIRECT' then
-             initasmmode:=asmmode_i386_direct
+             initasmmode:=asmmode_direct
            else
             IllegalPara(opt);
          end;
@@ -101,7 +101,13 @@ initialization
 end.
 {
   $Log$
-  Revision 1.1  2002-07-24 22:38:15  florian
+  Revision 1.2  2002-08-10 14:53:38  carl
+    + moved target_cpu_string to cpuinfo
+    * renamed asmmode enum.
+    * assembler reader has now less ifdef's
+    * move from nppcmem.pas -> ncgmem.pas vec. node.
+
+  Revision 1.1  2002/07/24 22:38:15  florian
     + initial release of x86-64 target code
 
   Revision 1.7  2002/05/18 13:34:22  peter

compiler/x86_64/radirect.pas

@@ -0,0 +1,318 @@
+{
+    $Id$
+    Copyright (c) 1998-2001 by Florian Klaempfl
+
+    Reads inline assembler and writes the lines direct to the output
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+unit Radirect;
+
+{$i fpcdefs.inc}
+
+interface
+
+    uses
+      node;
+
+     function assemble : tnode;
+
+  implementation
+
+    uses
+       { common }
+       cutils,
+       { global }
+       globals,verbose,
+       systems,
+       { aasm }
+       cpubase,aasmtai,
+       { symtable }
+       symconst,symbase,symtype,symsym,symtable,defbase,paramgr,
+       { pass 1 }
+       nbas,
+       { parser }
+       scanner,
+       rax86_64,
+       agx64att,
+       { codegen }
+       cgbase
+       ;
+
+    function assemble : tnode;
+
+      var
+         retstr,s,hs : string;
+         c : char;
+         ende : boolean;
+         srsym,sym : tsym;
+         srsymtable : tsymtable;
+         code : TAAsmoutput;
+         i,l : longint;
+
+       procedure writeasmline;
+         var
+           i : longint;
+         begin
+           i:=length(s);
+           while (i>0) and (s[i] in [' ',#9]) do
+            dec(i);
+           s[0]:=chr(i);
+           if s<>'' then
+            code.concat(Tai_direct.Create(strpnew(s)));
+            { consider it set function set if the offset was loaded }
+           if assigned(aktprocdef.funcretsym) and
+              (pos(retstr,upper(s))>0) then
+             tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
+           s:='';
+         end;
+
+     begin
+       ende:=false;
+       s:='';
+       if assigned(aktprocdef.funcretsym) and
+          is_fpu(aktprocdef.rettype.def) then
+         tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
+       if (not is_void(aktprocdef.rettype.def)) then
+         retstr:=upper(tostr(procinfo^.return_offset)+'('+att_reg2str[procinfo^.framepointer]+')')
+       else
+         retstr:='';
+         c:=current_scanner.asmgetchar;
+         code:=TAAsmoutput.Create;
+         while not(ende) do
+           begin
+              { wrong placement
+              current_scanner.gettokenpos; }
+              case c of
+                 'A'..'Z','a'..'z','_' : begin
+                      current_scanner.gettokenpos;
+                      i:=0;
+                      hs:='';
+                      while ((ord(c)>=ord('A')) and (ord(c)<=ord('Z')))
+                         or ((ord(c)>=ord('a')) and (ord(c)<=ord('z')))
+                         or ((ord(c)>=ord('0')) and (ord(c)<=ord('9')))
+                         or (c='_') do
+                        begin
+                           inc(i);
+                           hs[i]:=c;
+                           c:=current_scanner.asmgetchar;
+                        end;
+                      hs[0]:=chr(i);
+                      if upper(hs)='END' then
+                         ende:=true
+                      else
+                         begin
+                            if c=':' then
+                              begin
+                                searchsym(upper(hs),srsym,srsymtable);
+                                if srsym<>nil then
+                                  if (srsym.typ = labelsym) then
+                                    Begin
+                                       hs:=tlabelsym(srsym).lab.name;
+                                       tlabelsym(srsym).lab.is_set:=true;
+                                    end
+                                  else
+                                    Message(asmr_w_using_defined_as_local);
+                              end
+                            else if upper(hs)='FWAIT' then
+                             FwaitWarning
+                            else
+                            { access to local variables }
+                            if assigned(aktprocdef) then
+                              begin
+                                 { is the last written character an special }
+                                 { char ?                                   }
+                                 if (s[length(s)]='%') and
+                                    paramanager.ret_in_acc(aktprocdef.rettype.def) and
+                                    ((pos('AX',upper(hs))>0) or
+                                    (pos('AL',upper(hs))>0)) then
+                                   tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
+                                 if (s[length(s)]<>'%') and
+                                   (s[length(s)]<>'$') and
+                                   ((s[length(s)]<>'0') or (hs[1]<>'x')) then
+                                   begin
+                                      if assigned(aktprocdef.localst) and
+                                         (lexlevel >= normal_function_level) then
+                                        sym:=tsym(aktprocdef.localst.search(upper(hs)))
+                                      else
+                                        sym:=nil;
+                                      if assigned(sym) then
+                                        begin
+                                           if (sym.typ = labelsym) then
+                                             Begin
+                                                hs:=tlabelsym(sym).lab.name;
+                                             end
+                                           else if sym.typ=varsym then
+                                             begin
+                                             {variables set are after a comma }
+                                             {like in movl %eax,I }
+                                             if pos(',',s) > 0 then
+                                               tvarsym(sym).varstate:=vs_used
+                                             else
+                                             if (pos('MOV',upper(s)) > 0) and (tvarsym(sym).varstate=vs_declared) then
+                                              Message1(sym_n_uninitialized_local_variable,hs);
+                                             if (vo_is_external in tvarsym(sym).varoptions) then
+                                               hs:=tvarsym(sym).mangledname
+                                             else
+                                               hs:='-'+tostr(tvarsym(sym).address)+
+                                                   '('+att_reg2str[procinfo^.framepointer]+')';
+                                             end
+                                           else
+                                           { call to local function }
+                                           if (sym.typ=procsym) and ((pos('CALL',upper(s))>0) or
+                                              (pos('LEA',upper(s))>0)) then
+                                             begin
+                                                hs:=tprocsym(sym).defs^.def.mangledname;
+                                             end;
+                                        end
+                                      else
+                                        begin
+                                           if assigned(aktprocdef.parast) then
+                                             sym:=tsym(aktprocdef.parast.search(upper(hs)))
+                                           else
+                                             sym:=nil;
+                                           if assigned(sym) then
+                                             begin
+                                                if sym.typ=varsym then
+                                                  begin
+                                                     l:=tvarsym(sym).address;
+                                                     { set offset }
+                                                     inc(l,aktprocdef.parast.address_fixup);
+                                                     hs:=tostr(l)+'('+att_reg2str[procinfo^.framepointer]+')';
+                                                     if pos(',',s) > 0 then
+                                                       tvarsym(sym).varstate:=vs_used;
+                                                  end;
+                                             end
+                                      { I added that but it creates a problem in line.ppi
+                                      because there is a local label wbuffer and
+                                      a static variable WBUFFER ...
+                                      what would you decide, florian ?}
+                                      else
+
+                                        begin
+                                           searchsym(upper(hs),sym,srsymtable);
+                                           if assigned(sym) and (sym.owner.symtabletype in [globalsymtable,staticsymtable]) then
+                                             begin
+                                               case sym.typ of
+                                                 varsym :
+                                                   begin
+                                                     Message2(asmr_h_direct_global_to_mangled,hs,tvarsym(sym).mangledname);
+                                                     hs:=tvarsym(sym).mangledname;
+                                                     inc(tvarsym(sym).refs);
+                                                   end;
+                                                 typedconstsym :
+                                                   begin
+                                                     Message2(asmr_h_direct_global_to_mangled,hs,ttypedconstsym(sym).mangledname);
+                                                     hs:=ttypedconstsym(sym).mangledname;
+                                                   end;
+                                                 procsym :
+                                                   begin
+                                                     { procs can be called or the address can be loaded }
+                                                     if ((pos('CALL',upper(s))>0) or (pos('LEA',upper(s))>0)) then
+                                                      begin
+                                                        if assigned(tprocsym(sym).defs^.def) then
+                                                          Message1(asmr_w_direct_global_is_overloaded_func,hs);
+                                                        Message2(asmr_h_direct_global_to_mangled,hs,tprocsym(sym).defs^.def.mangledname);
+                                                        hs:=tprocsym(sym).defs^.def.mangledname;
+                                                      end;
+                                                   end;
+                                                 else
+                                                   Message(asmr_e_wrong_sym_type);
+                                               end;
+                                             end
+                                           else if upper(hs)='__SELF' then
+                                             begin
+                                                if assigned(procinfo^._class) then
+                                                  hs:=tostr(procinfo^.selfpointer_offset)+
+                                                      '('+att_reg2str[procinfo^.framepointer]+')'
+                                                else
+                                                 Message(asmr_e_cannot_use_SELF_outside_a_method);
+                                             end
+                                           else if upper(hs)='__RESULT' then
+                                             begin
+                                                if (not is_void(aktprocdef.rettype.def)) then
+                                                  hs:=retstr
+                                                else
+                                                  Message(asmr_e_void_function);
+                                             end
+                                           else if upper(hs)='__OLDEBP' then
+                                             begin
+                                                { complicate to check there }
+                                                { we do it: }
+                                                if lexlevel>normal_function_level then
+                                                  hs:=tostr(procinfo^.framepointer_offset)+
+                                                    '('+att_reg2str[procinfo^.framepointer]+')'
+                                                else
+                                                  Message(asmr_e_cannot_use_OLDEBP_outside_nested_procedure);
+                                             end;
+                                           end;
+                                        end;
+                                   end;
+                              end;
+                            s:=s+hs;
+                         end;
+                   end;
+ '{',';',#10,#13 : begin
+                      if pos(retstr,s) > 0 then
+                        tfuncretsym(aktprocdef.funcretsym).funcretstate:=vs_assigned;
+                     writeasmline;
+                     c:=current_scanner.asmgetchar;
+                   end;
+             #26 : Message(scan_f_end_of_file);
+             else
+               begin
+                 current_scanner.gettokenpos;
+                 inc(byte(s[0]));
+                 s[length(s)]:=c;
+                 c:=current_scanner.asmgetchar;
+               end;
+           end;
+         end;
+       writeasmline;
+       assemble:=casmnode.create(code);
+     end;
+
+{*****************************************************************************
+                                     Initialize
+*****************************************************************************}
+
+const
+  asmmode_i386_direct_info : tasmmodeinfo =
+          (
+            id    : asmmode_direct;
+            idtxt : 'DIRECT'
+          );
+
+initialization
+  RegisterAsmMode(asmmode_i386_direct_info);
+
+end.
+{
+  $Log$
+  Revision 1.1  2002-08-10 14:53:38  carl
+    + moved target_cpu_string to cpuinfo
+    * renamed asmmode enum.
+    * assembler reader has now less ifdef's
+    * move from nppcmem.pas -> ncgmem.pas vec. node.
+
+  Revision 1.2  2002/07/25 22:55:34  florian
+    * several fixes, small test units can be compiled
+
+  Revision 1.1  2002/07/24 22:38:15  florian
+    + initial release of x86-64 target code
+
+}

compiler/x86_64/rasm.pas

@@ -0,0 +1,73 @@
+{
+    $Id$
+    Copyright (c) 1998-2002 by The Free Pascal Team
+
+    This unit does the parsing process for the inline assembler
+
+    This program is free software; you can redistribute it and/or modify
+    it under the terms of the GNU General Public License as published by
+    the Free Software Foundation; either version 2 of the License, or
+    (at your option) any later version.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+    GNU General Public License for more details.
+
+    You should have received a copy of the GNU General Public License
+    along with this program; if not, write to the Free Software
+    Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+
+ ****************************************************************************
+}
+
+Unit Rasm;
+
+{$i fpcdefs.inc}
+
+Interface
+
+uses
+  node;
+
+   { 
+     This routine is called to parse the instructions in assembler
+     blocks. It returns a complete list of directive and instructions
+   }  
+   function assemble: tnode;
+
+
+Implementation
+
+    uses
+       { common }
+       cutils,cclasses,
+       { global }
+       globtype,globals,verbose,
+       systems,
+       { aasm }
+       cpubase,aasmbase,aasmtai,aasmcpu,
+       { symtable }
+       symconst,symbase,symtype,symsym,symtable,
+       { pass 1 }
+       nbas,
+       { parser }
+       scanner,
+       rautils
+       ;
+
+    function assemble : tnode;
+     begin
+     end;
+     
+Begin
+end.
+{
+  $Log$
+  Revision 1.1  2002-08-10 14:53:38  carl
+    + moved target_cpu_string to cpuinfo
+    * renamed asmmode enum.
+    * assembler reader has now less ifdef's
+    * move from nppcmem.pas -> ncgmem.pas vec. node.
+
+}