+ aktasmmode, aktoptprocessor, aktoutputformat

  + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
  + $LIBNAME to set the library name where the unit will be put in
  * splitted cgi386 a bit (codeseg to large for bp7)
  * nasm, tasm works again. nasm moved to ag386nsm.pas

compiler/aasm.pas

@@ -29,11 +29,6 @@ unit aasm;
 
 {$I version.inc}
     type
-{$ifdef klaempfl}
-{$ifdef ver0_9_2}
-       extended = double;
-{$endif ver0_9_2}
-{$endif klaempfl}
        tait = (
           ait_string,
           ait_label,
@@ -81,7 +76,6 @@ unit aasm;
        end;
 
        pai_string = ^tai_string;
-
        tai_string = object(tai)
           str : pchar;
           { extra len so the string can contain an \0 }
@@ -117,23 +111,24 @@ unit aasm;
           destructor done; virtual;
        end;
 
-       { type for a temporary label }
-       { test if used for dispose of unnecessary labels }
-       pai_label = ^tai_label;
+     { type for a temporary label test if used for dispose of
+       unnecessary labels }
+       plabel = ^tlabel;
        tlabel = record
-                nb : longint;
-                is_used : boolean;
-                is_set : boolean;
-                refcount : word;
+                  nb       : longint;
+                  is_used  : boolean;
+                  is_set   : boolean;
+                  refcount : word;
                 end;
 
-       plabel = ^tlabel;
+       pai_label = ^tai_label;
        tai_label = object(tai)
           l : plabel;
           constructor init(_l : plabel);
           destructor done; virtual;
        end;
 
+
        pai_direct = ^tai_direct;
        tai_direct = object(tai)
           str : pchar;
@@ -272,10 +267,27 @@ type
     procedure concat_external(const _name : string;exttype : texternal_typ);
     procedure concat_internal(const _name : string;exttype : texternal_typ);
 
-  implementation
+  { label functions }
+    const
+      nextlabelnr : longint = 1;
+    { convert label to string}
+    function lab2str(l : plabel) : string;
+    { make l as a new label }
+    procedure getlabel(var l : plabel);
+    { frees the label if unused }
+    procedure freelabel(var l : plabel);
+    { make a new zero label }
+    procedure getzerolabel(var l : plabel);
+    { reset a label to a zero label }
+    procedure setzerolabel(var l : plabel);
+    {just get a label number }
+    procedure getlabelnr(var l : longint);
+
 
-  uses
-    strings,verbose;
+implementation
+
+uses
+  strings,verbose,systems;
 
 {****************************************************************************
                              TAI
@@ -402,66 +414,6 @@ type
          inherited done;
       end;
 
-    function search_assembler_symbol(pl : paasmoutput;const _name : string;exttype : texternal_typ) : pai_external;
-
-      var
-         p : pai;
-
-      begin
-         search_assembler_symbol:=nil;
-         if pl=nil then
-           internalerror(2001)
-         else
-           begin
-              p:=pai(pl^.first);
-              while (p<>nil) and
-                    (p<>pai(pl^.last)) do
-                { if we get the same name with a different typ }
-                { there is probably an error                   }
-                if (p^.typ=ait_external) and
-                   ((exttype=EXT_ANY) or (pai_external(p)^.exttyp=exttype)) and
-                   (strpas(pai_external(p)^.name)=_name) then
-                  begin
-                     search_assembler_symbol:=pai_external(p);
-                     exit;
-                  end
-                else
-                  p:=pai(p^.next);
-              if (p<>nil) and
-                 (p^.typ=ait_external) and
-                 (pai_external(p)^.exttyp=exttype) and
-                 (strpas(pai_external(p)^.name)=_name) then
-                begin
-                   search_assembler_symbol:=pai_external(p);
-                   exit;
-                end;
-           end;
-      end;
-
-    { insert each need external only once }
-    procedure concat_external(const _name : string;exttype : texternal_typ);
-
-      var
-         p : pai_external;
-
-      begin
-         p:=search_assembler_symbol(externals,_name,exttype);
-         if p=nil then
-           externals^.concat(new(pai_external,init(_name,exttype)));
-      end;
-
-    { insert each need external only once }
-    procedure concat_internal(const _name : string;exttype : texternal_typ);
-
-      var
-         p : pai_external;
-
-      begin
-         p:=search_assembler_symbol(internals,_name,exttype);
-         if p=nil then
-           internals^.concat(new(pai_external,init(_name,exttype)));
-      end;
-
 {****************************************************************************
                                TAI_CONST
  ****************************************************************************}
@@ -721,10 +673,147 @@ type
           typ:=ait_cut;
        end;
 
+
+{*****************************************************************************
+                           External Helpers
+*****************************************************************************}
+
+    function search_assembler_symbol(pl : paasmoutput;const _name : string;exttype : texternal_typ) : pai_external;
+      var
+         p : pai;
+      begin
+         search_assembler_symbol:=nil;
+         if pl=nil then
+           internalerror(2001)
+         else
+           begin
+              p:=pai(pl^.first);
+              while (p<>nil) and
+                    (p<>pai(pl^.last)) do
+                { if we get the same name with a different typ }
+                { there is probably an error                   }
+                if (p^.typ=ait_external) and
+                   ((exttype=EXT_ANY) or (pai_external(p)^.exttyp=exttype)) and
+                   (strpas(pai_external(p)^.name)=_name) then
+                  begin
+                     search_assembler_symbol:=pai_external(p);
+                     exit;
+                  end
+                else
+                  p:=pai(p^.next);
+              if (p<>nil) and
+                 (p^.typ=ait_external) and
+                 (pai_external(p)^.exttyp=exttype) and
+                 (strpas(pai_external(p)^.name)=_name) then
+                begin
+                   search_assembler_symbol:=pai_external(p);
+                   exit;
+                end;
+           end;
+      end;
+
+
+    { insert each need external only once }
+    procedure concat_external(const _name : string;exttype : texternal_typ);
+      begin
+        if not target_asm.externals then
+         exit;
+        if search_assembler_symbol(externals,_name,exttype)=nil then
+         externals^.concat(new(pai_external,init(_name,exttype)));
+      end;
+
+
+    { insert each need internal only once }
+    procedure concat_internal(const _name : string;exttype : texternal_typ);
+      begin
+        if not target_asm.externals then
+         exit;
+        if search_assembler_symbol(internals,_name,exttype)=nil then
+         internals^.concat(new(pai_external,init(_name,exttype)));
+      end;
+
+
+{*****************************************************************************
+                              Label Helpers
+*****************************************************************************}
+
+    function lab2str(l : plabel) : string;
+      begin
+         if (l=nil) or (l^.nb=0) then
+{$ifdef EXTDEBUG}
+           lab2str:='ILLEGAL'
+         else
+           lab2str:=target_asm.labelprefix+tostr(l^.nb);
+{$else EXTDEBUG}
+         internalerror(2000);
+         lab2str:=target_asm.labelprefix+tostr(l^.nb);
+{$endif EXTDEBUG}
+         { was missed: }
+         inc(l^.refcount);
+         l^.is_used:=true;
+      end;
+
+
+    procedure getlabel(var l : plabel);
+      begin
+         new(l);
+         l^.nb:=nextlabelnr;
+         l^.is_used:=false;
+         l^.is_set:=false;
+         l^.refcount:=0;
+         inc(nextlabelnr);
+      end;
+
+
+    procedure freelabel(var l : plabel);
+      begin
+         if (l<>nil) and (not l^.is_set) and (not l^.is_used) then
+           dispose(l);
+         l:=nil;
+      end;
+
+
+    procedure setzerolabel(var l : plabel);
+      begin
+        with l^ do
+         begin
+           nb:=0;
+           is_used:=false;
+           is_set:=false;
+           refcount:=0;
+         end;
+      end;
+
+
+    procedure getzerolabel(var l : plabel);
+      begin
+         new(l);
+         l^.nb:=0;
+         l^.is_used:=false;
+         l^.is_set:=false;
+         l^.refcount:=0;
+      end;
+
+
+    procedure getlabelnr(var l : longint);
+      begin
+         l:=nextlabelnr;
+         inc(nextlabelnr);
+      end;
+
+
+
 end.
 {
   $Log$
-  Revision 1.7  1998-05-07 00:16:59  peter
+  Revision 1.8  1998-05-23 01:20:53  peter
+    + aktasmmode, aktoptprocessor, aktoutputformat
+    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
+    + $LIBNAME to set the library name where the unit will be put in
+    * splitted cgi386 a bit (codeseg to large for bp7)
+    * nasm, tasm works again. nasm moved to ag386nsm.pas
+
+  Revision 1.7  1998/05/07 00:16:59  peter
     * smartlinking for sets
     + consts labels are now concated/generated in hcodegen
     * moved some cpu code to cga and some none cpu depended code from cga

compiler/ag386int.pas

@@ -50,6 +50,36 @@ unit ag386int;
              ('NEAR','FAR','PROC','BYTE','WORD','DWORD',
               'CODEPTR','DATAPTR','FWORD','PWORD','QWORD','TBYTE','ABS');
 
+
+    function double2str(d : double) : string;
+      var
+         hs : string;
+         p : byte;
+      begin
+         str(d,hs);
+      { nasm expects a lowercase e }
+         p:=pos('E',hs);
+         if p>0 then
+          hs[p]:='e';
+         p:=pos('+',hs);
+         if p>0 then
+          delete(hs,p,1);
+         double2str:=lower(hs);
+      end;
+
+
+    function comp2str(d : bestreal) : string;
+      type
+        pdouble = ^double;
+      var
+        c  : comp;
+        dd : pdouble;
+      begin
+         c:=d;
+         dd:=pdouble(@c); { this makes a bitwise copy of c into a double }
+         comp2str:=double2str(dd^);
+      end;
+
     function getreferencestring(const ref : treference) : string;
     var
       s     : string;
@@ -62,15 +92,9 @@ unit ag386int;
         begin
           first:=true;
           if ref.segment<>R_DEFAULT_SEG then
-           begin
-             if current_module^.output_format in [of_nasm,of_obj] then
-              s:='['+int_reg2str[segment]+':'
-             else
-              s:=int_reg2str[segment]+':[';
-           end
+           s:=int_reg2str[segment]+':['
           else
            s:='[';
-
          if assigned(symbol) then
           begin
             s:=s+symbol^;
@@ -104,131 +128,88 @@ unit ag386int;
      end;
 
     function getopstr(t : byte;o : pointer;s : topsize; _operator: tasmop;dest : boolean) : string;
-
-      var
-    hs : string;
-
-      begin
-    case t of
-       top_reg : { a floating point register can be only a register operand }
-            if current_module^.output_format in [of_nasm,of_obj] then
-               getopstr:=int_nasmreg2str[tregister(o)]
-            else
-               getopstr:=int_reg2str[tregister(o)];
-       top_const,
+    var
+      hs : string;
+    begin
+      case t of
+       top_reg : getopstr:=int_reg2str[tregister(o)];
+     top_const,
        top_ref : begin
-                  if t=top_const then
-                    hs := tostr(longint(o))
-                  else
-                    hs:=getreferencestring(preference(o)^);
-                  if current_module^.output_format in [of_nasm,of_obj] then
-                    if (_operator = A_LEA) or (_operator = A_LGS)
-                    or (_operator = A_LSS) or (_operator = A_LFS)
-                    or (_operator = A_LES) or (_operator = A_LDS)
-                    or (_operator = A_SHR) or (_operator = A_SHL)
-                    or (_operator = A_SAR) or (_operator = A_SAL)
-                    or (_operator = A_OUT) or (_operator = A_IN) then
-                    begin
-                    end
-                    else
+                   if t=top_const then
+                     hs := tostr(longint(o))
+                   else
+                     hs:=getreferencestring(preference(o)^);
+                   { can possibly give a range check error under tp }
+                   { if using in...                                 }
+                   if ((_operator <> A_LGS) and (_operator <> A_LSS) and
+                       (_operator <> A_LFS) and (_operator <> A_LDS) and
+                       (_operator <> A_LES)) then
+                    Begin
                       case s of
-                         S_B : hs:='byte '+hs;
-                         S_W : hs:='word '+hs;
-                         S_L : hs:='dword '+hs;
-                         S_IS : hs:='word '+hs;
-                         S_IL : hs:='dword '+hs;
-                         S_IQ : hs:='qword '+hs;
-                         S_FS : hs:='dword '+hs;
-                         S_FL : hs:='qword '+hs;
-                         S_FX : hs:='tword '+hs;
-                         S_BW : if dest then
-                             hs:='word '+hs
-                           else
-                             hs:='byte '+hs;
-                         S_BL : if dest then
-                             hs:='dword '+hs
-                           else
-                             hs:='byte '+hs;
-                         S_WL : if dest then
-                             hs:='dword '+hs
-                           else
-                             hs:='word '+hs;
-                      end
-          else
-          Begin
-            { can possibly give a range check error under tp }
-            { if using in...                                 }
-            if ((_operator <> A_LGS) and (_operator <> A_LSS) and
-               (_operator <> A_LFS) and (_operator <> A_LDS) and
-               (_operator <> A_LES)) then
-            Begin
-            case s of
-               S_B : hs:='byte ptr '+hs;
-               S_W : hs:='word ptr '+hs;
-               S_L : hs:='dword ptr '+hs;
-               S_IS : hs:='word ptr '+hs;
-               S_IL : hs:='dword ptr '+hs;
-               S_IQ : hs:='qword ptr '+hs;
-               S_FS : hs:='dword ptr '+hs;
-               S_FL : hs:='qword ptr '+hs;
-               S_FX : hs:='tbyte ptr '+hs;
-               S_BW : if dest then
-                   hs:='word ptr '+hs
-                 else
-                   hs:='byte ptr '+hs;
-               S_BL : if dest then
-                   hs:='dword ptr '+hs
-                 else
-                   hs:='byte ptr '+hs;
-               S_WL : if dest then
-                   hs:='dword ptr '+hs
-                 else
-                   hs:='word ptr '+hs;
-            end;
-            end;
-          end;
-              getopstr:=hs;
-            end;
-       top_symbol : begin
-             hs[0]:=chr(strlen(pchar(pcsymbol(o)^.symbol)));
-             move(pchar(pcsymbol(o)^.symbol)^,hs[1],byte(hs[0]));
-             if current_module^.output_format=of_masm then
-               hs:='offset '+hs
-             else
-               hs:='dword '+hs;
-
-             if pcsymbol(o)^.offset>0 then
-               hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
-             else if pcsymbol(o)^.offset<0 then
-               hs:=hs+tostr(pcsymbol(o)^.offset);
-             getopstr:=hs;
-          end;
-       else internalerror(10001);
-    end;
+                       S_B : hs:='byte ptr '+hs;
+                       S_W : hs:='word ptr '+hs;
+                       S_L : hs:='dword ptr '+hs;
+                      S_IS : hs:='word ptr '+hs;
+                      S_IL : hs:='dword ptr '+hs;
+                      S_IQ : hs:='qword ptr '+hs;
+                      S_FS : hs:='dword ptr '+hs;
+                      S_FL : hs:='qword ptr '+hs;
+                      S_FX : hs:='tbyte ptr '+hs;
+                      S_BW : if dest then
+                              hs:='word ptr '+hs
+                             else
+                              hs:='byte ptr '+hs;
+                      S_BL : if dest then
+                              hs:='dword ptr '+hs
+                             else
+                              hs:='byte ptr '+hs;
+                      S_WL : if dest then
+                              hs:='dword ptr '+hs
+                             else
+                              hs:='word ptr '+hs;
+                      end;
+                    end;
+                   getopstr:=hs;
+                 end;
+    top_symbol : begin
+                   hs[0]:=chr(strlen(pchar(pcsymbol(o)^.symbol)));
+                   move(pchar(pcsymbol(o)^.symbol)^,hs[1],byte(hs[0]));
+                   hs:='offset '+hs;
+                   if pcsymbol(o)^.offset>0 then
+                    hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
+                   else
+                    if pcsymbol(o)^.offset<0 then
+                     hs:=hs+tostr(pcsymbol(o)^.offset);
+                   getopstr:=hs;
+                 end;
+      else
+       internalerror(10001);
       end;
+    end;
 
     function getopstr_jmp(t : byte;o : pointer) : string;
-
-      var
-    hs : string;
-
-      begin
-    case t of
-       top_reg : getopstr_jmp:=int_reg2str[tregister(o)];
-       top_ref : getopstr_jmp:=getreferencestring(preference(o)^);
+    var
+      hs : string;
+    begin
+      case t of
+         top_reg : getopstr_jmp:=int_reg2str[tregister(o)];
+         top_ref : getopstr_jmp:=getreferencestring(preference(o)^);
        top_const : getopstr_jmp:=tostr(longint(o));
        top_symbol : begin
-             hs[0]:=chr(strlen(pchar(pcsymbol(o)^.symbol)));
-             move(pchar(pcsymbol(o)^.symbol)^,hs[1],byte(hs[0]));
-             if pcsymbol(o)^.offset>0 then
-               hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
-             else if pcsymbol(o)^.offset<0 then
-               hs:=hs+tostr(pcsymbol(o)^.offset);
-             getopstr_jmp:=hs;
-          end;
-       else internalerror(10001);
-    end;
+                      hs[0]:=chr(strlen(pchar(pcsymbol(o)^.symbol)));
+                      move(pchar(pcsymbol(o)^.symbol)^,hs[1],byte(hs[0]));
+                      if pcsymbol(o)^.offset>0 then
+                        hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
+                      else
+                        if pcsymbol(o)^.offset<0 then
+                          hs:=hs+tostr(pcsymbol(o)^.offset);
+                      getopstr_jmp:=hs;
+                    end;
+      else
+       internalerror(10001);
       end;
+    end;
+
 
 {****************************************************************************
                                TI386INTASMLIST
@@ -237,14 +218,10 @@ unit ag386int;
     var
       LastSec : tsection;
 
-
     const
       ait_const2str:array[ait_const_32bit..ait_const_8bit] of string[8]=
         (#9'DD'#9,'',#9'DW'#9,#9'DB'#9);
 
-      ait_section2nasmstr : array[tsection] of string[6]=
-       ('','.text','.data','.bss','.idata');
-
       ait_section2masmstr : array[tsection] of string[6]=
        ('','CODE','DATA','BSS','');
 
@@ -297,50 +274,29 @@ unit ag386int;
                        AsmLn;
                      End;
        ait_section : begin
-                       if current_module^.output_format in [of_nasm,of_obj] then
-                         AsmWriteLn('SECTION '+ait_section2nasmstr[pai_section(hp)^.sec])
-                       else
-
-
-                         begin
-                           if LastSec<>sec_none then
-                             AsmWriteLn('_'+ait_section2masmstr[LastSec]+#9#9'ENDS');
-                           AsmWriteLn('_'+ait_section2masmstr[pai_section(hp)^.sec]+'DATA'#9#9+
-                             'SEGMENT'#9'PARA PUBLIC USE32 '''+ait_section2masmstr[pai_section(hp)^.sec]+'''');
-                         end;
-
+                       if LastSec<>sec_none then
+                        AsmWriteLn('_'+ait_section2masmstr[LastSec]+#9#9'ENDS');
+                       if pai_section(hp)^.sec<>sec_none then
+                        begin
+                          AsmLn;
+                          AsmWriteLn('_'+ait_section2masmstr[pai_section(hp)^.sec]+#9#9+
+                                     'SEGMENT'#9'PARA PUBLIC USE32 '''+
+                                     ait_section2masmstr[pai_section(hp)^.sec]+'''');
+                        end;
                        LastSec:=pai_section(hp)^.sec;
                      end;
          ait_align : begin
-                     { align not supported at all with nasm v095  }
-                     { align with specific value not supported by }
-                     { turbo assembler.                           }
                      { CAUSES PROBLEMS WITH THE SEGMENT DEFINITION   }
                      { SEGMENT DEFINITION SHOULD MATCH TYPE OF ALIGN }
                      { HERE UNDER TASM!                              }
-                     { if current_module^.output_format<>of_nasm then }
-                        AsmWriteLn(#9'ALIGN '+tostr(pai_align(hp)^.aligntype));
-                     end;
-      ait_external : begin
-                       if current_module^.output_format in [of_nasm,of_obj] then
-                        AsmWriteLn('EXTERN '+StrPas(pai_external(hp)^.name))
-                       else
-                        AsmWriteLn(#9#9'EXTRN'#9+StrPas(pai_external(hp)^.name)+
-                                   ' :'+extstr[pai_external(hp)^.exttyp]);
+                       AsmWriteLn(#9'ALIGN '+tostr(pai_align(hp)^.aligntype));
                      end;
+      ait_external : AsmWriteLn(#9'EXTRN'#9+StrPas(pai_external(hp)^.name)+
+                                ' :'+extstr[pai_external(hp)^.exttyp]);
      ait_datablock : begin
-                       if current_module^.output_format in [of_nasm,of_obj] then
-                        begin
-                          if pai_datablock(hp)^.is_global then
-                           AsmWriteLn('GLOBAL '+StrPas(pai_datablock(hp)^.name));
-                          AsmWriteLn(PadTabs(pai_datablock(hp)^.name,':')+'RESB'#9+tostr(pai_datablock(hp)^.size));
-                        end
-                       else
-                        begin
-                          if pai_datablock(hp)^.is_global then
-                           AsmWriteLn(#9#9'PUBLIC'#9+StrPas(pai_datablock(hp)^.name));
-                          AsmWriteLn(PadTabs(pai_datablock(hp)^.name,#0)+'DB'#9+tostr(pai_datablock(hp)^.size)+' DUP(?)');
-                        end;
+                       if pai_datablock(hp)^.is_global then
+                         AsmWriteLn(#9'PUBLIC'#9+StrPas(pai_datablock(hp)^.name));
+                       AsmWriteLn(PadTabs(pai_datablock(hp)^.name,#0)+'DB'#9+tostr(pai_datablock(hp)^.size)+' DUP(?)');
                      end;
    ait_const_32bit,
     ait_const_8bit,
@@ -361,30 +317,13 @@ unit ag386int;
                        AsmLn;
                      end;
   ait_const_symbol : begin
-                       if current_module^.output_format<>of_nasm then
-                        AsmWrite(#9#9+'DD '#9'offset ')
-                       else
-                        AsmWrite(#9#9+'DD '#9);
-                       AsmWriteLn(StrPas(pchar(pai_const(hp)^.value)));
+                       AsmWrite(#9#9+'DD '#9'offset ');
+                       AsmWritePChar(pchar(pai_const(hp)^.value));
+                       AsmLn;
                      end;
     ait_real_32bit : AsmWriteLn(#9#9'DD'#9+double2str(pai_single(hp)^.value));
     ait_real_64bit : AsmWriteLn(#9#9'DQ'#9+double2str(pai_double(hp)^.value));
- ait_real_extended : begin
-                     { nasm v095 does not like DT with real constants }
-                     { therefore write as double.                     }
-                     { other possible solution: decode directly to hex}
-                     { value.                                         }
-                       if current_module^.output_format<>of_nasm then
-                        AsmWriteLn(#9#9'DT'#9+double2str(pai_extended(hp)^.value))
-                       else
-                        begin
-{$ifdef EXTDEBUG}
-                          AsmLn;
-                          AsmWriteLn('; NASM bug work around for extended real');
-{$endif}
-                          AsmWriteLn(#9#9'DD'#9+double2str(pai_extended(hp)^.value))
-                        end;
-                     end;
+ ait_real_extended : AsmWriteLn(#9#9'DT'#9+double2str(pai_extended(hp)^.value));
           ait_comp : AsmWriteLn(#9#9'DQ'#9+comp2str(pai_extended(hp)^.value));
         ait_string : begin
                        counter := 0;
@@ -461,38 +400,27 @@ unit ag386int;
                        AsmLn;
                      end;
          ait_label : begin
-                       AsmWrite(lab2str(pai_label(hp)^.l));
-                       if (current_module^.output_format in [of_obj,of_nasm]) or
-                          (assigned(hp^.next) and not(pai(hp^.next)^.typ in
-                           [ait_const_32bit,ait_const_16bit,ait_const_8bit,ait_const_symbol,
-                            ait_real_32bit,ait_real_64bit,ait_real_extended,ait_string])) then
-                        AsmWriteLn(':');
+                       if pai_label(hp)^.l^.is_used then
+                        begin
+                          AsmWrite(lab2str(pai_label(hp)^.l));
+                          if (assigned(hp^.next) and not(pai(hp^.next)^.typ in
+                             [ait_const_32bit,ait_const_16bit,ait_const_8bit,ait_const_symbol,
+                              ait_real_32bit,ait_real_64bit,ait_real_extended,ait_string])) then
+                           AsmWriteLn(':');
+                        end;
                      end;
         ait_direct : begin
                        AsmWritePChar(pai_direct(hp)^.str);
                        AsmLn;
                      end;
-ait_labeled_instruction :
-                     begin
-                       if (current_module^.output_format in [of_nasm,of_obj]) and
-                          not (pai_labeled(hp)^._operator in [A_JMP,A_LOOP,A_LOOPZ,A_LOOPE,
-                          A_LOOPNZ,A_LOOPNE,A_JCXZ,A_JECXZ]) then
-                        AsmWriteLn(#9#9+int_op2str[pai_labeled(hp)^._operator]+#9+'near '+lab2str(pai_labeled(hp)^.lab))
-                       else
-                        AsmWriteLn(#9#9+int_op2str[pai_labeled(hp)^._operator]+#9+lab2str(pai_labeled(hp)^.lab));
-                     end;
+ait_labeled_instruction : AsmWriteLn(#9#9+int_op2str[pai_labeled(hp)^._operator]+#9+lab2str(pai_labeled(hp)^.lab));
         ait_symbol : begin
                        if pai_symbol(hp)^.is_global then
-                        begin
-                          if current_module^.output_format in [of_nasm,of_obj] then
-                           AsmWriteLn('GLOBAL '+StrPas(pai_symbol(hp)^.name))
-                          else
-                           AsmWriteLn(#9#9'PUBLIC'#9+StrPas(pai_symbol(hp)^.name));
-                        end;
+                         AsmWriteLn(#9'PUBLIC'#9+StrPas(pai_symbol(hp)^.name));
                        AsmWritePChar(pai_symbol(hp)^.name);
                        if assigned(hp^.next) and not(pai(hp^.next)^.typ in
-                        [ait_const_32bit,ait_const_16bit,ait_const_8bit,ait_const_symbol,
-                         ait_real_64bit,ait_string]) then
+                          [ait_const_32bit,ait_const_16bit,ait_const_8bit,ait_const_symbol,
+                           ait_real_64bit,ait_real_extended,ait_string]) then
                         AsmWriteLn(':')
                      end;
    ait_instruction : begin
@@ -514,33 +442,24 @@ ait_labeled_instruction :
                              AsmWriteLn(s);
                              break;
                            end;
-                          { nasm prefers prefix on a line alone }
-                          if (current_module^.output_format in [of_nasm,of_obj]) then
-                            begin
-                               AsmWriteln(#9#9+prefix);
-                               prefix:='';
-                            end;
                         end
                        else
                         prefix:= '';
-                       { A_FNSTS need the w as suffix at least for nasm}
-                       if (current_module^.output_format in [of_nasm,of_obj]) then
-                         if (pai386(hp)^._operator = A_FNSTS) then
-                           pai386(hp)^._operator:=A_FNSTSW
-                         else if (pai386(hp)^._operator = A_FSTS) then
-                           pai386(hp)^._operator:=A_FSTSW;
                        if pai386(hp)^.op1t<>top_none then
                         begin
                           if pai386(hp)^._operator in [A_CALL] then
                            begin
-                             if output_format=of_nasm then
-                              s:=getopstr_jmp(pai386(hp)^.op1t,pai386(hp)^.op1)
-                              { with tasm call near ptr [edi+12] does not
-                                work but call near [edi+12] works ?? (PM)}
-                             else if pai386(hp)^.op1t=top_ref then
-                                s:='near '+getopstr_jmp(pai386(hp)^.op1t,pai386(hp)^.op1)
+                           { with tasm call near ptr [edi+12] does not
+                             work but call near [edi+12] works ?? (PM)
+
+                             It works with call dword ptr [], but you
+                             need /m2 (2 passes) with tasm (PFV)
+                           }
+{                                    if pai386(hp)^.op1t=top_ref then
+                              s:='near '+getopstr_jmp(pai386(hp)^.op1t,pai386(hp)^.op1)
                              else
-                                s:='near ptr '+getopstr_jmp(pai386(hp)^.op1t,pai386(hp)^.op1);
+                              s:='near ptr '+getopstr_jmp(pai386(hp)^.op1t,pai386(hp)^.op1);}
+                             s:='dword ptr '+getopstr_jmp(pai386(hp)^.op1t,pai386(hp)^.op1);
                            end
                           else
                            begin
@@ -550,8 +469,8 @@ ait_labeled_instruction :
                                 if pai386(hp)^.op2t<>top_none then
                                  s:=getopstr(pai386(hp)^.op2t,pointer(longint(twowords(pai386(hp)^.op2).word1)),
                                              pai386(hp)^.size,pai386(hp)^._operator,true)+','+s;
-                                          s:=getopstr(pai386(hp)^.op3t,pointer(longint(twowords(pai386(hp)^.op2).word2)),
-                                           pai386(hp)^.size,pai386(hp)^._operator,false)+','+s;
+                                s:=getopstr(pai386(hp)^.op3t,pointer(longint(twowords(pai386(hp)^.op2).word2)),
+                                            pai386(hp)^.size,pai386(hp)^._operator,false)+','+s;
                               end
                              else
                               if pai386(hp)^.op2t<>top_none then
@@ -607,17 +526,11 @@ ait_stab_function_name : ;
        comment(v_info,'Start writing intel-styled assembler output for '+current_module^.mainsource^);
 {$endif}
       LastSec:=sec_none;
-      if current_module^.output_format in [of_nasm,of_obj] then
-       AsmWriteLn('BITS 32')
-      else
-       begin
-         AsmWriteLn(#9'.386p');
-         AsmWriteLn(#9'LOCALS '+target_asm.labelprefix);
-         AsmWriteLn('DGROUP'#9#9'GROUP'#9'_BSS,_DATA');
-         AsmWriteLn(#9#9'ASSUME'#9'CS:_TEXT,ES:DGROUP,DS:DGROUP,SS:DGROUP');
-       end;
-
-
+      AsmWriteLn(#9'.386p');
+      AsmWriteLn(#9'LOCALS '+target_asm.labelprefix);
+      AsmWriteLn('DGROUP'#9'GROUP'#9'_BSS,_DATA');
+      AsmWriteLn(#9'ASSUME'#9'CS:_CODE,ES:DGROUP,DS:DGROUP,SS:DGROUP');
+      AsmLn;
 
       WriteTree(externals);
     { INTEL ASM doesn't support stabs
@@ -629,10 +542,7 @@ ait_stab_function_name : ;
       WriteTree(rttilist);
       WriteTree(bsssegment);
 
-      if not (current_module^.output_format in [of_nasm,of_obj]) then
-       AsmWriteLn(#9#9'END');
-
-
+      AsmWriteLn(#9'END');
       AsmLn;
 
 {$ifdef EXTDEBUG}
@@ -644,7 +554,14 @@ ait_stab_function_name : ;
 end.
 {
   $Log$
-  Revision 1.8  1998-05-06 18:36:53  peter
+  Revision 1.9  1998-05-23 01:20:55  peter
+    + aktasmmode, aktoptprocessor, aktoutputformat
+    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
+    + $LIBNAME to set the library name where the unit will be put in
+    * splitted cgi386 a bit (codeseg to large for bp7)
+    * nasm, tasm works again. nasm moved to ag386nsm.pas
+
+  Revision 1.8  1998/05/06 18:36:53  peter
     * tai_section extended with code,data,bss sections and enumerated type
     * ident 'compiled by FPC' moved to pmodules
     * small fix for smartlink

compiler/ag386nsm.pas

@@ -0,0 +1,547 @@
+{
+    $Id$
+    Copyright (c) 1996,97 by Florian Klaempfl
+
+    This unit implements an asmoutput class for the Nasm assembler with
+    Intel syntax for the i386+
+
+    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 ag386nsm;
+
+    interface
+
+    uses aasm,assemble;
+
+    type
+      pi386nasmasmlist=^ti386nasmasmlist;
+      ti386nasmasmlist = object(tasmlist)
+        procedure WriteTree(p:paasmoutput);virtual;
+        procedure WriteAsmList;virtual;
+      end;
+
+  implementation
+
+    uses
+      dos,globals,systems,cobjects,i386,
+      strings,files,verbose
+{$ifdef GDB}
+      ,gdb
+{$endif GDB}
+      ;
+
+    const
+      line_length = 70;
+
+      extstr : array[EXT_NEAR..EXT_ABS] of String[8] =
+             ('NEAR','FAR','PROC','BYTE','WORD','DWORD',
+              'CODEPTR','DATAPTR','FWORD','PWORD','QWORD','TBYTE','ABS');
+
+    function double2str(d : double) : string;
+      var
+         hs : string;
+         p : byte;
+      begin
+         str(d,hs);
+      { nasm expects a lowercase e }
+         p:=pos('E',hs);
+         if p>0 then
+          hs[p]:='e';
+         p:=pos('+',hs);
+         if p>0 then
+          delete(hs,p,1);
+         double2str:=lower(hs);
+      end;
+
+
+    function comp2str(d : bestreal) : string;
+      type
+        pdouble = ^double;
+      var
+        c  : comp;
+        dd : pdouble;
+      begin
+         c:=d;
+         dd:=pdouble(@c); { this makes a bitwise copy of c into a double }
+         comp2str:=double2str(dd^);
+      end;
+
+
+    function getreferencestring(const ref : treference) : string;
+    var
+      s     : string;
+      first : boolean;
+    begin
+      if ref.isintvalue then
+       s:= tostr(ref.offset)
+      else
+      with ref do
+        begin
+          first:=true;
+          if ref.segment<>R_DEFAULT_SEG then
+           s:='['+int_reg2str[segment]+':'
+          else
+           s:='[';
+         if assigned(symbol) then
+          begin
+            s:=s+symbol^;
+            first:=false;
+          end;
+         if (base<>R_NO) then
+          begin
+            if not(first) then
+             s:=s+'+'
+            else
+             first:=false;
+             s:=s+int_reg2str[base];
+          end;
+         if (index<>R_NO) then
+           begin
+             if not(first) then
+               s:=s+'+'
+             else
+               first:=false;
+             s:=s+int_reg2str[index];
+             if scalefactor<>0 then
+               s:=s+'*'+tostr(scalefactor);
+           end;
+         if offset<0 then
+           s:=s+tostr(offset)
+         else if (offset>0) then
+           s:=s+'+'+tostr(offset);
+         s:=s+']';
+        end;
+       getreferencestring:=s;
+     end;
+
+    function getopstr(t : byte;o : pointer;s : topsize; _operator: tasmop;dest : boolean) : string;
+    var
+      hs : string;
+    begin
+      case t of
+       top_reg : getopstr:=int_nasmreg2str[tregister(o)];
+     top_const,
+       top_ref : begin
+                   if t=top_const then
+                     hs := tostr(longint(o))
+                   else
+                     hs:=getreferencestring(preference(o)^);
+                   if not ((_operator = A_LEA) or (_operator = A_LGS) or
+                           (_operator = A_LSS) or (_operator = A_LFS) or
+                           (_operator = A_LES) or (_operator = A_LDS) or
+                           (_operator = A_SHR) or (_operator = A_SHL) or
+                           (_operator = A_SAR) or (_operator = A_SAL) or
+                           (_operator = A_OUT) or (_operator = A_IN)) then
+                     begin
+                       case s of
+                          S_B : hs:='byte '+hs;
+                          S_W : hs:='word '+hs;
+                          S_L : hs:='dword '+hs;
+                          S_IS : hs:='word '+hs;
+                          S_IL : hs:='dword '+hs;
+                          S_IQ : hs:='qword '+hs;
+                          S_FS : hs:='dword '+hs;
+                          S_FL : hs:='qword '+hs;
+                          S_FX : hs:='tword '+hs;
+                          S_BW : if dest then
+                              hs:='word '+hs
+                            else
+                              hs:='byte '+hs;
+                          S_BL : if dest then
+                              hs:='dword '+hs
+                            else
+                              hs:='byte '+hs;
+                          S_WL : if dest then
+                              hs:='dword '+hs
+                            else
+                              hs:='word '+hs;
+                       end
+                     end;
+                   getopstr:=hs;
+                 end;
+    top_symbol : begin
+                   hs[0]:=chr(strlen(pchar(pcsymbol(o)^.symbol)));
+                   move(pchar(pcsymbol(o)^.symbol)^,hs[1],byte(hs[0]));
+                   hs:='dword '+hs;
+                   if pcsymbol(o)^.offset>0 then
+                     hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
+                   else
+                     if pcsymbol(o)^.offset<0 then
+                       hs:=hs+tostr(pcsymbol(o)^.offset);
+                   getopstr:=hs;
+                 end;
+      else
+        internalerror(10001);
+      end;
+    end;
+
+    function getopstr_jmp(t : byte;o : pointer) : string;
+    var
+      hs : string;
+    begin
+      case t of
+          top_reg : getopstr_jmp:=int_reg2str[tregister(o)];
+          top_ref : getopstr_jmp:=getreferencestring(preference(o)^);
+        top_const : getopstr_jmp:=tostr(longint(o));
+       top_symbol : begin
+                      hs[0]:=chr(strlen(pchar(pcsymbol(o)^.symbol)));
+                      move(pchar(pcsymbol(o)^.symbol)^,hs[1],byte(hs[0]));
+                      if pcsymbol(o)^.offset>0 then
+                        hs:=hs+'+'+tostr(pcsymbol(o)^.offset)
+                      else
+                        if pcsymbol(o)^.offset<0 then
+                          hs:=hs+tostr(pcsymbol(o)^.offset);
+                      getopstr_jmp:=hs;
+                    end;
+      else
+        internalerror(10001);
+      end;
+    end;
+
+{****************************************************************************
+                               Ti386nasmasmlist
+ ****************************************************************************}
+
+    var
+      LastSec : tsection;
+
+    const
+      ait_const2str:array[ait_const_32bit..ait_const_8bit] of string[8]=
+        (#9'DD'#9,'',#9'DW'#9,#9'DB'#9);
+
+      ait_section2nasmstr : array[tsection] of string[6]=
+       ('','.text','.data','.bss','.idata');
+
+    Function PadTabs(p:pchar;addch:char):string;
+    var
+      s : string;
+      i : longint;
+    begin
+      i:=strlen(p);
+      if addch<>#0 then
+       begin
+         inc(i);
+         s:=StrPas(p)+addch;
+       end
+      else
+       s:=StrPas(p);
+      if i<8 then
+       PadTabs:=s+#9#9
+      else
+       PadTabs:=s+#9;
+    end;
+
+
+    procedure ti386nasmasmlist.WriteTree(p:paasmoutput);
+    type
+      twowords=record
+        word1,word2:word;
+      end;
+    var
+      s,
+      prefix,
+      suffix   : string;
+      hp       : pai;
+      counter,
+      lines,
+      i,j,l    : longint;
+      consttyp : tait;
+      found,
+      quoted   : boolean;
+    begin
+      if not assigned(p) then
+       exit;
+      hp:=pai(p^.first);
+      while assigned(hp) do
+       begin
+         case hp^.typ of
+       ait_comment : Begin
+                       AsmWrite(target_asm.comment);
+                       AsmWritePChar(pai_asm_comment(hp)^.str);
+                       AsmLn;
+                     End;
+       ait_section : begin
+                       if pai_section(hp)^.sec<>sec_none then
+                        begin
+                          AsmLn;
+                          AsmWriteLn('SECTION '+ait_section2nasmstr[pai_section(hp)^.sec]);
+                        end;
+                       LastSec:=pai_section(hp)^.sec;
+                     end;
+         ait_align : AsmWriteLn(#9'ALIGN '+tostr(pai_align(hp)^.aligntype));
+      ait_external : AsmWriteLn('EXTERN '+StrPas(pai_external(hp)^.name));
+     ait_datablock : begin
+                       if pai_datablock(hp)^.is_global then
+                        AsmWriteLn(#9'GLOBAL '+StrPas(pai_datablock(hp)^.name));
+                       AsmWriteLn(PadTabs(pai_datablock(hp)^.name,':')+'RESB'#9+tostr(pai_datablock(hp)^.size));
+                     end;
+   ait_const_32bit,
+    ait_const_8bit,
+   ait_const_16bit : begin
+                       AsmWrite(ait_const2str[hp^.typ]+tostr(pai_const(hp)^.value));
+                       consttyp:=hp^.typ;
+                       l:=0;
+                       repeat
+                         found:=(not (Pai(hp^.next)=nil)) and (Pai(hp^.next)^.typ=consttyp);
+                         if found then
+                          begin
+                            hp:=Pai(hp^.next);
+                            s:=','+tostr(pai_const(hp)^.value);
+                            AsmWrite(s);
+                            inc(l,length(s));
+                          end;
+                       until (not found) or (l>line_length);
+                       AsmLn;
+                     end;
+  ait_const_symbol : begin
+                       AsmWrite(#9#9+'DD '#9);
+                       AsmWritePChar(pchar(pai_const(hp)^.value));
+                       AsmLn;
+                     end;
+    ait_real_32bit : AsmWriteLn(#9#9'DD'#9+double2str(pai_single(hp)^.value));
+    ait_real_64bit : AsmWriteLn(#9#9'DQ'#9+double2str(pai_double(hp)^.value));
+ ait_real_extended : AsmWriteLn(#9#9'DD'#9+double2str(pai_extended(hp)^.value));
+          ait_comp : AsmWriteLn(#9#9'DQ'#9+comp2str(pai_extended(hp)^.value));
+        ait_string : begin
+                       counter := 0;
+                       lines := pai_string(hp)^.len div line_length;
+                     { separate lines in different parts }
+                       if pai_string(hp)^.len > 0 then
+                        Begin
+                          for j := 0 to lines-1 do
+                           begin
+                             AsmWrite(#9#9'DB'#9);
+                             quoted:=false;
+                             for i:=counter to counter+line_length do
+                                begin
+                                  { it is an ascii character. }
+                                  if (ord(pai_string(hp)^.str[i])>31) and
+                                     (ord(pai_string(hp)^.str[i])<128) and
+                                     (pai_string(hp)^.str[i]<>'"') then
+                                      begin
+                                        if not(quoted) then
+                                            begin
+                                              if i>counter then
+                                                AsmWrite(',');
+                                              AsmWrite('"');
+                                            end;
+                                        AsmWrite(pai_string(hp)^.str[i]);
+                                        quoted:=true;
+                                      end { if > 31 and < 128 and ord('"') }
+                                  else
+                                      begin
+                                          if quoted then
+                                              AsmWrite('"');
+                                          if i>counter then
+                                              AsmWrite(',');
+                                          quoted:=false;
+                                          AsmWrite(tostr(ord(pai_string(hp)^.str[i])));
+                                      end;
+                               end; { end for i:=0 to... }
+                             if quoted then AsmWrite('"');
+                               AsmWrite(target_os.newline);
+                             counter := counter+line_length;
+                          end; { end for j:=0 ... }
+                        { do last line of lines }
+                        AsmWrite(#9#9'DB'#9);
+                        quoted:=false;
+                        for i:=counter to pai_string(hp)^.len-1 do
+                          begin
+                            { it is an ascii character. }
+                            if (ord(pai_string(hp)^.str[i])>31) and
+                               (ord(pai_string(hp)^.str[i])<128) and
+                               (pai_string(hp)^.str[i]<>'"') then
+                                begin
+                                  if not(quoted) then
+                                      begin
+                                        if i>counter then
+                                          AsmWrite(',');
+                                        AsmWrite('"');
+                                      end;
+                                  AsmWrite(pai_string(hp)^.str[i]);
+                                  quoted:=true;
+                                end { if > 31 and < 128 and " }
+                            else
+                                begin
+                                  if quoted then
+                                    AsmWrite('"');
+                                  if i>counter then
+                                      AsmWrite(',');
+                                  quoted:=false;
+                                  AsmWrite(tostr(ord(pai_string(hp)^.str[i])));
+                                end;
+                          end; { end for i:=0 to... }
+                        if quoted then
+                          AsmWrite('"');
+                        end;
+                       AsmLn;
+                     end;
+         ait_label : begin
+                       if pai_label(hp)^.l^.is_used then
+                        AsmWriteLn(lab2str(pai_label(hp)^.l)+':');
+                     end;
+        ait_direct : begin
+                       AsmWritePChar(pai_direct(hp)^.str);
+                       AsmLn;
+                     end;
+ait_labeled_instruction :
+                     begin
+                       if not (pai_labeled(hp)^._operator in [A_JMP,A_LOOP,A_LOOPZ,A_LOOPE,
+                          A_LOOPNZ,A_LOOPNE,A_JCXZ,A_JECXZ]) then
+                        AsmWriteLn(#9#9+int_op2str[pai_labeled(hp)^._operator]+#9+'near '+lab2str(pai_labeled(hp)^.lab))
+                       else
+                        AsmWriteLn(#9#9+int_op2str[pai_labeled(hp)^._operator]+#9+lab2str(pai_labeled(hp)^.lab));
+                     end;
+        ait_symbol : begin
+                       if pai_symbol(hp)^.is_global then
+                        AsmWriteLn(#9'GLOBAL '+StrPas(pai_symbol(hp)^.name));
+                       AsmWritePChar(pai_symbol(hp)^.name);
+                       if assigned(hp^.next) and not(pai(hp^.next)^.typ in
+                          [ait_const_32bit,ait_const_16bit,ait_const_8bit,ait_const_symbol,
+                           ait_real_64bit,ait_string]) then
+                        AsmWriteLn(':')
+                     end;
+   ait_instruction : begin
+                       suffix:='';
+                       prefix:= '';
+                     { added prefix instructions, must be on same line as opcode }
+                       if (pai386(hp)^.op1t = top_none) and
+                          ((pai386(hp)^._operator = A_REP) or
+                           (pai386(hp)^._operator = A_LOCK) or
+                           (pai386(hp)^._operator =  A_REPE) or
+                           (pai386(hp)^._operator = A_REPNE)) then
+                        Begin
+                          prefix:=int_op2str[pai386(hp)^._operator]+#9;
+                          hp:=Pai(hp^.next);
+                        { this is theorically impossible... }
+                          if hp=nil then
+                           begin
+                             s:=#9#9+prefix;
+                             AsmWriteLn(s);
+                             break;
+                           end;
+                          { nasm prefers prefix on a line alone }
+                          AsmWriteln(#9#9+prefix);
+                          prefix:='';
+                        end
+                       else
+                        prefix:= '';
+                       { A_FNSTS need the w as suffix at least for nasm}
+                       if (pai386(hp)^._operator = A_FNSTS) then
+                        pai386(hp)^._operator:=A_FNSTSW
+                       else
+                        if (pai386(hp)^._operator = A_FSTS) then
+                         pai386(hp)^._operator:=A_FSTSW;
+                       if pai386(hp)^.op1t<>top_none then
+                        begin
+                          if pai386(hp)^._operator in [A_CALL] then
+                           s:=getopstr_jmp(pai386(hp)^.op1t,pai386(hp)^.op1)
+                          else
+                           begin
+                             s:=getopstr(pai386(hp)^.op1t,pai386(hp)^.op1,pai386(hp)^.size,pai386(hp)^._operator,false);
+                             if pai386(hp)^.op3t<>top_none then
+                              begin
+                                if pai386(hp)^.op2t<>top_none then
+                                 s:=getopstr(pai386(hp)^.op2t,pointer(longint(twowords(pai386(hp)^.op2).word1)),
+                                             pai386(hp)^.size,pai386(hp)^._operator,true)+','+s;
+                                          s:=getopstr(pai386(hp)^.op3t,pointer(longint(twowords(pai386(hp)^.op2).word2)),
+                                           pai386(hp)^.size,pai386(hp)^._operator,false)+','+s;
+                              end
+                             else
+                              if pai386(hp)^.op2t<>top_none then
+                               s:=getopstr(pai386(hp)^.op2t,pai386(hp)^.op2,pai386(hp)^.size,
+                                           pai386(hp)^._operator,true)+','+s;
+                           end;
+                          s:=#9+s;
+                        end
+                       else
+                        begin
+                          { check if string instruction }
+                          { long form, otherwise may give range check errors }
+                          { in turbo pascal...                               }
+                          if ((pai386(hp)^._operator = A_CMPS) or
+                             (pai386(hp)^._operator = A_INS) or
+                             (pai386(hp)^._operator = A_OUTS) or
+                             (pai386(hp)^._operator = A_SCAS) or
+                             (pai386(hp)^._operator = A_STOS) or
+                             (pai386(hp)^._operator = A_MOVS) or
+                             (pai386(hp)^._operator = A_LODS) or
+                             (pai386(hp)^._operator = A_XLAT)) then
+                           Begin
+                             case pai386(hp)^.size of
+                              S_B: suffix:='b';
+                              S_W: suffix:='w';
+                              S_L: suffix:='d';
+                             else
+                              Message(assem_f_invalid_suffix_intel);
+                             end;
+                           end;
+                          s:='';
+                        end;
+                       AsmWriteLn(#9#9+prefix+int_op2str[pai386(hp)^._operator]+suffix+s);
+                     end;
+{$ifdef GDB}
+             ait_stabn,
+             ait_stabs,
+ait_stab_function_name : ;
+{$endif GDB}
+         else
+          internalerror(10000);
+         end;
+         hp:=pai(hp^.next);
+       end;
+    end;
+
+
+    procedure ti386nasmasmlist.WriteAsmList;
+    begin
+{$ifdef EXTDEBUG}
+      if assigned(current_module^.mainsource) then
+       comment(v_info,'Start writing nasm-styled assembler output for '+current_module^.mainsource^);
+{$endif}
+      LastSec:=sec_none;
+      AsmWriteLn('BITS 32');
+      AsmLn;
+
+      WriteTree(externals);
+    { Nasm doesn't support stabs
+      WriteTree(debuglist);}
+
+      WriteTree(codesegment);
+      WriteTree(datasegment);
+      WriteTree(consts);
+      WriteTree(rttilist);
+      WriteTree(bsssegment);
+
+      AsmLn;
+{$ifdef EXTDEBUG}
+      if assigned(current_module^.mainsource) then
+       comment(v_info,'Done writing nasm-styled assembler output for '+current_module^.mainsource^);
+{$endif EXTDEBUG}
+   end;
+
+end.
+{
+  $Log$
+  Revision 1.1  1998-05-23 01:20:56  peter
+    + aktasmmode, aktoptprocessor, aktoutputformat
+    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
+    + $LIBNAME to set the library name where the unit will be put in
+    * splitted cgi386 a bit (codeseg to large for bp7)
+    * nasm, tasm works again. nasm moved to ag386nsm.pas
+
+}

compiler/ag68kgas.pas

@@ -56,6 +56,34 @@ unit ag68kgas;
       infile : pextfile;
       includecount,lastline : longint;
 
+    function double2str(d : double) : string;
+      var
+         hs : string;
+         p : byte;
+      begin
+         str(d,hs);
+       { replace space with + }
+         if hs[1]=' ' then
+          hs[1]:='+';
+         double2str:='0d'+hs
+      end;
+
+
+    function comp2str(d : bestreal) : string;
+      type
+        pdouble = ^double;
+      var
+        c  : comp;
+        dd : pdouble;
+      begin
+         c:=d;
+      {$ifndef TP}
+         {$warning The following warning can be ignored}
+      {$endif TP}
+         dd:=pdouble(@c); { this makes a bitwise copy of c into a double }
+         comp2str:=double2str(dd^);
+      end;
+
     function getreferencestring(const ref : treference) : string;
       var
          s : string;
@@ -553,7 +581,14 @@ ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
 end.
 {
   $Log$
-  Revision 1.2  1998-04-29 10:33:41  pierre
+  Revision 1.3  1998-05-23 01:20:56  peter
+    + aktasmmode, aktoptprocessor, aktoutputformat
+    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
+    + $LIBNAME to set the library name where the unit will be put in
+    * splitted cgi386 a bit (codeseg to large for bp7)
+    * nasm, tasm works again. nasm moved to ag386nsm.pas
+
+  Revision 1.2  1998/04/29 10:33:41  pierre
     + added some code for ansistring (not complete nor working yet)
     * corrected operator overloading
     * corrected nasm output

compiler/ag68kmit.pas

@@ -57,6 +57,30 @@ unit ag68kmit;
       infile : pextfile;
       includecount,lastline : longint;
 
+    function double2str(d : double) : string;
+      var
+         hs : string;
+      begin
+         str(d,hs);
+         double2str:=hs;
+      end;
+
+
+    function comp2str(d : bestreal) : string;
+      type
+        pdouble = ^double;
+      var
+        c  : comp;
+        dd : pdouble;
+      begin
+         c:=d;{ this generates a warning but this is not important }
+      {$ifndef TP}
+         {$warning The following warning can be ignored}
+      {$endif TP}
+         dd:=pdouble(@c); { this makes a bitwise copy of c into a double }
+         comp2str:=double2str(dd^);
+      end;
+
     function getreferencestring(const ref : treference) : string;
       var
          s : string;
@@ -593,7 +617,14 @@ ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
 end.
 {
   $Log$
-  Revision 1.2  1998-04-29 10:33:42  pierre
+  Revision 1.3  1998-05-23 01:20:57  peter
+    + aktasmmode, aktoptprocessor, aktoutputformat
+    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
+    + $LIBNAME to set the library name where the unit will be put in
+    * splitted cgi386 a bit (codeseg to large for bp7)
+    * nasm, tasm works again. nasm moved to ag386nsm.pas
+
+  Revision 1.2  1998/04/29 10:33:42  pierre
     + added some code for ansistring (not complete nor working yet)
     * corrected operator overloading
     * corrected nasm output

compiler/ag68kmot.pas

@@ -48,6 +48,30 @@ unit ag68kmot;
     const
       line_length = 70;
 
+    function double2str(d : double) : string;
+      var
+         hs : string;
+      begin
+         str(d,hs);
+         double2str:=hs;
+      end;
+
+
+    function comp2str(d : bestreal) : string;
+      type
+        pdouble = ^double;
+      var
+        c  : comp;
+        dd : pdouble;
+      begin
+         c:=d;{ this generates a warning but this is not important }
+      {$ifndef TP}
+         {$warning The following warning can be ignored}
+      {$endif TP}
+         dd:=pdouble(@c); { this makes a bitwise copy of c into a double }
+         comp2str:=double2str(dd^);
+      end;
+
     function getreferencestring(const ref : treference) : string;
       var
          s : string;
@@ -498,7 +522,14 @@ ait_labeled_instruction :
 end.
 {
   $Log$
-  Revision 1.2  1998-04-29 10:33:42  pierre
+  Revision 1.3  1998-05-23 01:20:58  peter
+    + aktasmmode, aktoptprocessor, aktoutputformat
+    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
+    + $LIBNAME to set the library name where the unit will be put in
+    * splitted cgi386 a bit (codeseg to large for bp7)
+    * nasm, tasm works again. nasm moved to ag386nsm.pas
+
+  Revision 1.2  1998/04/29 10:33:42  pierre
     + added some code for ansistring (not complete nor working yet)
     * corrected operator overloading
     * corrected nasm output

compiler/aopt386.pas

@@ -491,7 +491,7 @@ End;
                        (Pai386(p)^.Size = S_L) And
                        ((Pai386(p)^.op3t = Top_Reg) or
                         (Pai386(p)^.op3t = Top_None)) And
-                       (Opt_Processors < PentiumPro) And
+                       (aktoptprocessor < PentiumPro) And
                        (Longint(Pai386(p)^.op1) <= 12) And
                        Not(CS_LittleSize in AktSwitches) And
                        (Not(GetNextInstruction(p, hp1)) Or
@@ -548,7 +548,7 @@ End;
                                imul 6, reg1 to
                                  lea (reg1,reg1,2), reg1
                                  add reg1, reg1}
-                                If (Opt_Processors <= i486)
+                                If (aktoptprocessor <= i486)
                                   Then
                                     Begin
                                       TmpRef^.Index := TRegister(Pai386(p)^.op2);
@@ -618,7 +618,7 @@ End;
                                imul 10, reg1 to
                                  lea (reg1,reg1,4), reg1
                                  add reg1, reg1}
-                                 If (Opt_Processors <= i486) Then
+                                 If (aktoptprocessor <= i486) Then
                                    Begin
                                      If (Pai386(p)^.op3t = Top_Reg)
                                        Then
@@ -653,7 +653,7 @@ End;
                                imul 12, reg1 to
                                  lea (reg1,reg1,2), reg1
                                  lea (,reg1,4), reg1}
-                                 If (Opt_Processors <= i486)
+                                 If (aktoptprocessor <= i486)
                                    Then
                                      Begin
                                        TmpRef^.Index := TRegister(Pai386(p)^.op2);
@@ -1105,8 +1105,8 @@ End;
                                           Else
                                             If IsGP32Reg(TRegister(Pai386(p)^.op2)) And
                                                Not(CS_LittleSize in AktSwitches) And
-                                               (Opt_Processors >= Pentium) And
-                                               (Opt_Processors < PentiumPro)
+                                               (aktoptprocessor >= Pentium) And
+                                               (aktoptprocessor < PentiumPro)
                                               Then
                                                 {Change "movzbl %reg1, %reg2" to
                                                  "xorl %reg2, %reg2; movb %reg1, %reg2" for Pentium and
@@ -1162,8 +1162,8 @@ End;
                                    (PReference(Pai386(p)^.op1)^.index <> TRegister(Pai386(p)^.op2)) And
                                    Not(CS_LittleSize in AktSwitches) And
                                    IsGP32Reg(TRegister(Pai386(p)^.op2)) And
-                                   (Opt_Processors >= Pentium) And
-                                   (Opt_Processors < PentiumPro) And
+                                   (aktoptprocessor >= Pentium) And
+                                   (aktoptprocessor < PentiumPro) And
                                    (Pai386(p)^.Size = S_BL)
                                   Then
                                     {changes "movzbl mem, %reg" to "xorl %reg, %reg; movb mem, %reg8" for
@@ -1318,7 +1318,7 @@ End;
                                           End;
                                   End;
                                 If TmpBool2 Or
-                                   ((Opt_Processors < PentiumPro) And
+                                   ((aktoptprocessor < PentiumPro) And
                                     (Longint(Pai386(p)^.op1) <= 3) And
                                     Not(CS_LittleSize in AktSwitches))
                                    Then
@@ -1340,7 +1340,7 @@ End;
                                      End;
                              End
                            Else
-                             If (Opt_Processors < PentiumPro) And
+                             If (aktoptprocessor < PentiumPro) And
                                 (Pai386(p)^.op1t = top_const) And
                                 (Pai386(p)^.op2t = top_reg) Then
                                If (Longint(Pai386(p)^.op1) = 1)
@@ -1621,7 +1621,14 @@ end;
 End.
 {
   $Log$
-  Revision 1.10  1998-05-10 12:06:30  jonas
+  Revision 1.11  1998-05-23 01:21:00  peter
+    + aktasmmode, aktoptprocessor, aktoutputformat
+    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
+    + $LIBNAME to set the library name where the unit will be put in
+    * splitted cgi386 a bit (codeseg to large for bp7)
+    * nasm, tasm works again. nasm moved to ag386nsm.pas
+
+  Revision 1.10  1998/05/10 12:06:30  jonas
     * bugfix in a_mov optimizations; completed bugfix of "sub $2,esp;...;movw reg, y(%esp)"
 
   Revision 1.9  1998/05/06 08:38:34  pierre

compiler/assemble.pas

@@ -82,7 +82,7 @@ uses
 {$endif}
   ,strings
 {$ifdef i386}
-  ,ag386att,ag386int
+  ,ag386att,ag386int,ag386nsm
 {$endif}
 {$ifdef m68k}
   ,ag68kmot,ag68kgas,ag68kmit
@@ -110,7 +110,7 @@ end;
 
 Function DoPipe:boolean;
 begin
-  DoPipe:=use_pipe and (not WriteAsmFile) and (current_module^.output_format=of_o);
+  DoPipe:=use_pipe and (not WriteAsmFile) and (aktoutputformat=as_o);
 end;
 
 
@@ -276,7 +276,7 @@ end;
 
 procedure TAsmList.AsmCreate;
 begin
-  if SmartLink then
+  if (cs_smartlink in aktswitches) then
    NextSmartName;
 {$ifdef linux}
   if DoPipe then
@@ -353,7 +353,7 @@ begin
   OutCnt:=0;
 {Smartlinking}
   SmartLinkFilesCnt:=0;
-  if smartlink then
+  if (cs_smartlink in aktswitches) then
    begin
      path:=SmartLinkPath(name);
      {$I-}
@@ -378,20 +378,19 @@ Procedure GenerateAsm(const fn:string);
 var
   a : PAsmList;
 begin
-  case current_module^.output_format of
+  case aktoutputformat of
 {$ifdef i386}
-     of_o,
- of_win32,
-   of_att : a:=new(pi386attasmlist,Init(fn));
-   of_obj,
-  of_masm,
-  of_nasm : a:=new(pi386intasmlist,Init(fn));
+        as_o : a:=new(pi386attasmlist,Init(fn));
+ as_nasmcoff,
+  as_nasmelf,
+  as_nasmobj : a:=new(pi386nasmasmlist,Init(fn));
+     as_tasm : a:=new(pi386intasmlist,Init(fn));
 {$endif}
 {$ifdef m68k}
-     of_o,
-   of_gas : a:=new(pm68kgasasmlist,Init(fn));
-   of_mot : a:=new(pm68kmotasmlist,Init(fn));
-   of_mit : a:=new(pm68kmitasmlist,Init(fn));
+     as_o,
+   as_gas : a:=new(pm68kgasasmlist,Init(fn));
+   as_mot : a:=new(pm68kmotasmlist,Init(fn));
+   as_mit : a:=new(pm68kmitasmlist,Init(fn));
 {$endif}
   else
    internalerror(30000);
@@ -417,7 +416,14 @@ end;
 end.
 {
   $Log$
-  Revision 1.8  1998-05-11 13:07:53  peter
+  Revision 1.9  1998-05-23 01:21:01  peter
+    + aktasmmode, aktoptprocessor, aktoutputformat
+    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
+    + $LIBNAME to set the library name where the unit will be put in
+    * splitted cgi386 a bit (codeseg to large for bp7)
+    * nasm, tasm works again. nasm moved to ag386nsm.pas
+
+  Revision 1.8  1998/05/11 13:07:53  peter
     + $ifdef NEWPPU for the new ppuformat
     + $define GDB not longer required
     * removed all warnings and stripped some log comments

compiler/cg386con.pas

@@ -0,0 +1,222 @@
+{
+    $Id$
+    Copyright (c) 1993-98 by Florian Klaempfl
+
+    Generate i386 assembler for constants
+
+    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 cg386con;
+interface
+
+   uses tree;
+
+    procedure secondrealconst(var p : ptree);
+    procedure secondfixconst(var p : ptree);
+    procedure secondordconst(var p : ptree);
+    procedure secondniln(var p : ptree);
+    procedure secondstringconst(var p : ptree);
+
+implementation
+
+   uses
+     cobjects,verbose,
+     symtable,aasm,i386,
+     hcodegen;
+
+    procedure secondrealconst(var p : ptree);
+
+      var
+         hp1 : pai;
+         lastlabel : plabel;
+         found : boolean;
+      begin
+         clear_reference(p^.location.reference);
+         lastlabel:=nil;
+         found:=false;
+         { const already used ? }
+         if p^.labnumber=-1 then
+           begin
+              { tries to found an old entry }
+              hp1:=pai(consts^.first);
+              while assigned(hp1) do
+                begin
+                   if hp1^.typ=ait_label then
+                     lastlabel:=pai_label(hp1)^.l
+                   else
+                     begin
+                        if (hp1^.typ=p^.realtyp) and (lastlabel<>nil) then
+                          begin
+                             if ((p^.realtyp=ait_real_64bit) and (pai_double(hp1)^.value=p^.valued)) or
+                               ((p^.realtyp=ait_real_extended) and (pai_extended(hp1)^.value=p^.valued)) or
+                               ((p^.realtyp=ait_real_32bit) and (pai_single(hp1)^.value=p^.valued)) then
+                               begin
+                                  { found! }
+                                  p^.labnumber:=lastlabel^.nb;
+                                  break;
+                               end;
+                          end;
+                        lastlabel:=nil;
+                     end;
+                   hp1:=pai(hp1^.next);
+                end;
+              { :-(, we must generate a new entry }
+              if p^.labnumber=-1 then
+                begin
+                   getlabel(lastlabel);
+                   p^.labnumber:=lastlabel^.nb;
+                   concat_constlabel(lastlabel,constreal);
+                   case p^.realtyp of
+                     ait_real_64bit : consts^.concat(new(pai_double,init(p^.valued)));
+                     ait_real_32bit : consts^.concat(new(pai_single,init(p^.valued)));
+                  ait_real_extended : consts^.concat(new(pai_extended,init(p^.valued)));
+                   else
+                     internalerror(10120);
+                   end;
+                end;
+           end;
+         stringdispose(p^.location.reference.symbol);
+         if assigned(lastlabel) then
+           p^.location.reference.symbol:=stringdup(constlabel2str(lastlabel,constreal))
+         else
+           p^.location.reference.symbol:=stringdup(constlabelnb2str(p^.labnumber,constreal));
+      end;
+
+    procedure secondfixconst(var p : ptree);
+
+      begin
+         { an fix comma const. behaves as a memory reference }
+         p^.location.loc:=LOC_MEM;
+         p^.location.reference.isintvalue:=true;
+         p^.location.reference.offset:=p^.valuef;
+      end;
+
+    procedure secondordconst(var p : ptree);
+
+      begin
+         { an integer const. behaves as a memory reference }
+         p^.location.loc:=LOC_MEM;
+         p^.location.reference.isintvalue:=true;
+         p^.location.reference.offset:=p^.value;
+      end;
+
+    procedure secondniln(var p : ptree);
+
+      begin
+         p^.location.loc:=LOC_MEM;
+         p^.location.reference.isintvalue:=true;
+         p^.location.reference.offset:=0;
+      end;
+
+    procedure secondstringconst(var p : ptree);
+
+      var
+         hp1 : pai;
+         lastlabel : plabel;
+         pc : pchar;
+         same_string : boolean;
+         i : word;
+
+      begin
+         clear_reference(p^.location.reference);
+         lastlabel:=nil;
+         { const already used ? }
+         if p^.labstrnumber=-1 then
+           begin
+              { tries to found an old entry }
+              hp1:=pai(consts^.first);
+              while assigned(hp1) do
+                begin
+                   if hp1^.typ=ait_label then
+                     lastlabel:=pai_label(hp1)^.l
+                   else
+                     begin
+                        if (hp1^.typ=ait_string) and (lastlabel<>nil) and
+                          (pai_string(hp1)^.len=length(p^.values^)+2) then
+                          begin
+                             same_string:=true;
+{$ifndef UseAnsiString}
+                             for i:=1 to length(p^.values^) do
+                               if pai_string(hp1)^.str[i]<>p^.values^[i] then
+{$else}
+                             for i:=0 to p^.length do
+                               if pai_string(hp1)^.str[i]<>p^.values[i] then
+{$endif}
+                                 begin
+                                    same_string:=false;
+                                    break;
+                                 end;
+                             if same_string then
+                               begin
+                                  { found! }
+                                  p^.labstrnumber:=lastlabel^.nb;
+                                  break;
+                               end;
+                          end;
+                        lastlabel:=nil;
+                     end;
+                   hp1:=pai(hp1^.next);
+                end;
+              { :-(, we must generate a new entry }
+              if p^.labstrnumber=-1 then
+                begin
+                   getlabel(lastlabel);
+                   p^.labstrnumber:=lastlabel^.nb;
+{$ifndef UseAnsiString}
+                   getmem(pc,length(p^.values^)+3);
+                   move(p^.values^,pc^,length(p^.values^)+1);
+                   pc[length(p^.values^)+1]:=#0;
+{$else UseAnsiString}
+                   pc:=getpcharcopy(p);
+{$endif UseAnsiString}
+
+                   concat_constlabel(lastlabel,conststring);
+{$ifdef UseAnsiString}
+  {$ifdef debug}
+                   consts^.concat(new(pai_asm_comment,init('Header of ansistring')));
+  {$endif debug}
+                   consts^.concat(new(pai_const,init_32bit(p^.length)));
+                   consts^.concat(new(pai_const,init_32bit(p^.length)));
+                   consts^.concat(new(pai_const,init_32bit(-1)));
+                   { to overcome this problem we set the length explicitly }
+                   { with the ending null char }
+                   consts^.concat(new(pai_string,init_length_pchar(pc,p^.length+1)));
+{$else UseAnsiString}
+                   { we still will have a problem if there is a #0 inside the pchar }
+                   consts^.concat(new(pai_string,init_length_pchar(pc,length(p^.values^)+2)));
+{$endif UseAnsiString}
+                end;
+           end;
+         stringdispose(p^.location.reference.symbol);
+         if assigned(lastlabel) then
+           p^.location.reference.symbol:=stringdup(constlabel2str(lastlabel,conststring))
+         else
+           p^.location.reference.symbol:=stringdup(constlabelnb2str(p^.labnumber,conststring));
+         p^.location.loc := LOC_MEM;
+      end;
+
+end.
+{
+  $Log$
+  Revision 1.1  1998-05-23 01:21:02  peter
+    + aktasmmode, aktoptprocessor, aktoutputformat
+    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
+    + $LIBNAME to set the library name where the unit will be put in
+    * splitted cgi386 a bit (codeseg to large for bp7)
+    * nasm, tasm works again. nasm moved to ag386nsm.pas
+
+}

compiler/cgi386.pas

@@ -66,6 +66,7 @@ implementation
 {$ifdef TP}
      ,cgi3862
 {$endif}
+     ,cg386con
      ;
 
     const
@@ -105,9 +106,9 @@ implementation
       begin
          if not(codegenerror) then
            begin
-              olderrorcount:=errorcount;
+              olderrorcount:=status.errorcount;
               verbose.Message(t);
-              codegenerror:=olderrorcount<>errorcount;
+              codegenerror:=olderrorcount<>status.errorcount;
            end;
       end;
 
@@ -119,9 +120,9 @@ implementation
       begin
          if not(codegenerror) then
            begin
-              olderrorcount:=errorcount;
+              olderrorcount:=status.errorcount;
               verbose.Message1(t,s);
-              codegenerror:=olderrorcount<>errorcount;
+              codegenerror:=olderrorcount<>status.errorcount;
            end;
       end;
 
@@ -133,9 +134,9 @@ implementation
       begin
          if not(codegenerror) then
            begin
-              olderrorcount:=errorcount;
+              olderrorcount:=status.errorcount;
               verbose.Message2(t,s1,s2);
-              codegenerror:=olderrorcount<>errorcount;
+              codegenerror:=olderrorcount<>status.errorcount;
            end;
       end;
 
@@ -147,9 +148,9 @@ implementation
       begin
          if not(codegenerror) then
            begin
-              olderrorcount:=errorcount;
+              olderrorcount:=status.errorcount;
               verbose.Message3(t,s1,s2,s3);
-              codegenerror:=olderrorcount<>errorcount;
+              codegenerror:=olderrorcount<>status.errorcount;
            end;
       end;
 
@@ -588,177 +589,6 @@ implementation
          usedinproc:=usedinproc or ($80 shr byte(R_ECX));
       end;
 
-    procedure secondrealconst(var p : ptree);
-
-      var
-         hp1 : pai;
-         lastlabel : plabel;
-         found : boolean;
-      begin
-         clear_reference(p^.location.reference);
-         lastlabel:=nil;
-         found:=false;
-         { const already used ? }
-         if p^.labnumber=-1 then
-           begin
-              { tries to found an old entry }
-              hp1:=pai(consts^.first);
-              while assigned(hp1) do
-                begin
-                   if hp1^.typ=ait_label then
-                     lastlabel:=pai_label(hp1)^.l
-                   else
-                     begin
-                        if (hp1^.typ=p^.realtyp) and (lastlabel<>nil) then
-                          begin
-                             if ((p^.realtyp=ait_real_64bit) and (pai_double(hp1)^.value=p^.valued)) or
-                               ((p^.realtyp=ait_real_extended) and (pai_extended(hp1)^.value=p^.valued)) or
-                               ((p^.realtyp=ait_real_32bit) and (pai_single(hp1)^.value=p^.valued)) then
-                               begin
-                                  { found! }
-                                  p^.labnumber:=lastlabel^.nb;
-                                  break;
-                               end;
-                          end;
-                        lastlabel:=nil;
-                     end;
-                   hp1:=pai(hp1^.next);
-                end;
-              { :-(, we must generate a new entry }
-              if p^.labnumber=-1 then
-                begin
-                   getlabel(lastlabel);
-                   p^.labnumber:=lastlabel^.nb;
-                   concat_constlabel(lastlabel,constreal);
-                   case p^.realtyp of
-                     ait_real_64bit : consts^.concat(new(pai_double,init(p^.valued)));
-                     ait_real_32bit : consts^.concat(new(pai_single,init(p^.valued)));
-                  ait_real_extended : consts^.concat(new(pai_extended,init(p^.valued)));
-                   else
-                     internalerror(10120);
-                   end;
-                end;
-           end;
-         stringdispose(p^.location.reference.symbol);
-         if assigned(lastlabel) then
-           p^.location.reference.symbol:=stringdup(constlabel2str(lastlabel,constreal))
-         else
-           p^.location.reference.symbol:=stringdup(constlabelnb2str(p^.labnumber,constreal));
-      end;
-
-    procedure secondfixconst(var p : ptree);
-
-      begin
-         { an fix comma const. behaves as a memory reference }
-         p^.location.loc:=LOC_MEM;
-         p^.location.reference.isintvalue:=true;
-         p^.location.reference.offset:=p^.valuef;
-      end;
-
-    procedure secondordconst(var p : ptree);
-
-      begin
-         { an integer const. behaves as a memory reference }
-         p^.location.loc:=LOC_MEM;
-         p^.location.reference.isintvalue:=true;
-         p^.location.reference.offset:=p^.value;
-      end;
-
-    procedure secondniln(var p : ptree);
-
-      begin
-         p^.location.loc:=LOC_MEM;
-         p^.location.reference.isintvalue:=true;
-         p^.location.reference.offset:=0;
-      end;
-
-    procedure secondstringconst(var p : ptree);
-
-      var
-         hp1 : pai;
-         lastlabel : plabel;
-         pc : pchar;
-         same_string : boolean;
-         i : word;
-
-      begin
-         clear_reference(p^.location.reference);
-         lastlabel:=nil;
-         { const already used ? }
-         if p^.labstrnumber=-1 then
-           begin
-              { tries to found an old entry }
-              hp1:=pai(consts^.first);
-              while assigned(hp1) do
-                begin
-                   if hp1^.typ=ait_label then
-                     lastlabel:=pai_label(hp1)^.l
-                   else
-                     begin
-                        if (hp1^.typ=ait_string) and (lastlabel<>nil) and
-                          (pai_string(hp1)^.len=length(p^.values^)+2) then
-                          begin
-                             same_string:=true;
-{$ifndef UseAnsiString}
-                             for i:=1 to length(p^.values^) do
-                               if pai_string(hp1)^.str[i]<>p^.values^[i] then
-{$else}
-                             for i:=0 to p^.length do
-                               if pai_string(hp1)^.str[i]<>p^.values[i] then
-{$endif}
-                                 begin
-                                    same_string:=false;
-                                    break;
-                                 end;
-                             if same_string then
-                               begin
-                                  { found! }
-                                  p^.labstrnumber:=lastlabel^.nb;
-                                  break;
-                               end;
-                          end;
-                        lastlabel:=nil;
-                     end;
-                   hp1:=pai(hp1^.next);
-                end;
-              { :-(, we must generate a new entry }
-              if p^.labstrnumber=-1 then
-                begin
-                   getlabel(lastlabel);
-                   p^.labstrnumber:=lastlabel^.nb;
-{$ifndef UseAnsiString}
-                   getmem(pc,length(p^.values^)+3);
-                   move(p^.values^,pc^,length(p^.values^)+1);
-                   pc[length(p^.values^)+1]:=#0;
-{$else UseAnsiString}
-                   pc:=getpcharcopy(p);
-{$endif UseAnsiString}
-
-                   concat_constlabel(lastlabel,conststring);
-{$ifdef UseAnsiString}
-  {$ifdef debug}
-                   consts^.concat(new(pai_asm_comment,init('Header of ansistring')));
-  {$endif debug}
-                   consts^.concat(new(pai_const,init_32bit(p^.length)));
-                   consts^.concat(new(pai_const,init_32bit(p^.length)));
-                   consts^.concat(new(pai_const,init_32bit(-1)));
-                   { to overcome this problem we set the length explicitly }
-                   { with the ending null char }
-                   consts^.concat(new(pai_string,init_length_pchar(pc,p^.length+1)));
-{$else UseAnsiString}
-                   { we still will have a problem if there is a #0 inside the pchar }
-                   consts^.concat(new(pai_string,init_length_pchar(pc,length(p^.values^)+2)));
-{$endif UseAnsiString}
-                end;
-           end;
-         stringdispose(p^.location.reference.symbol);
-         if assigned(lastlabel) then
-           p^.location.reference.symbol:=stringdup(constlabel2str(lastlabel,conststring))
-         else
-           p^.location.reference.symbol:=stringdup(constlabelnb2str(p^.labnumber,conststring));
-         p^.location.loc := LOC_MEM;
-      end;
-
     procedure secondumminus(var p : ptree);
 
 {$ifdef SUPPORT_MMX}
@@ -1255,7 +1085,7 @@ implementation
                    LOC_FLAGS:
                      begin
                         ind:=getregister32;
-                        exprasmlist^.concat(new(pai386,op_reg(flag_2_set[p^.right^.location.resflags],S_NO,reg32toreg8(ind))));
+                        exprasmlist^.concat(new(pai386,op_reg(flag_2_set[p^.right^.location.resflags],S_B,reg32toreg8(ind))));
                         emit_reg_reg(A_MOVZX,S_BL,reg32toreg8(ind),ind);
                      end
                    else
@@ -2067,7 +1897,7 @@ implementation
                 hp^.location.register,p^.location.register)));
            LOC_FLAGS:
               begin
-                 exprasmlist^.concat(new(pai386,op_reg(flag_2_set[hp^.location.resflags],S_NO,
+                 exprasmlist^.concat(new(pai386,op_reg(flag_2_set[hp^.location.resflags],S_B,
                    p^.location.register)))
               end;
            LOC_JUMP:
@@ -2347,10 +2177,10 @@ implementation
                            end;
             LOC_FLAGS    : begin
                               if loc=LOC_CREGISTER then
-                                exprasmlist^.concat(new(pai386,op_reg(flag_2_set[p^.right^.location.resflags],S_NO,
+                                exprasmlist^.concat(new(pai386,op_reg(flag_2_set[p^.right^.location.resflags],S_B,
                                   p^.left^.location.register)))
                               else
-                                exprasmlist^.concat(new(pai386,op_ref(flag_2_set[p^.right^.location.resflags],S_NO,
+                                exprasmlist^.concat(new(pai386,op_ref(flag_2_set[p^.right^.location.resflags],S_B,
                                   newreference(p^.left^.location.reference))));
                            end;
          end;
@@ -2834,7 +2664,7 @@ implementation
                         { clear full EAX is faster }
                         { but dont you set the equal flag ? }
                         {exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_L,R_EAX,R_EAX)));}
-                        exprasmlist^.concat(new(pai386,op_reg(flag_2_set[p^.left^.location.resflags],S_NO,
+                        exprasmlist^.concat(new(pai386,op_reg(flag_2_set[p^.left^.location.resflags],S_B,
                           R_AL)));
                         exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BW,R_AL,R_AX)));
                         {exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_L,R_EAX,R_EAX)));}
@@ -3421,7 +3251,7 @@ implementation
                    { but the registers must be different!              }
                    else if (pushedparasize=8) and
                      not(cs_littlesize in aktswitches) and
-                     (opt_processors=pentium) and
+                     (aktoptprocessor=pentium) and
                      (procinfo._class=nil) then
                        begin
                           exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDI)));
@@ -3690,24 +3520,22 @@ implementation
       procedure handlereadwrite(doread,callwriteln : boolean);
 
         procedure loadstream;
-
-          const     io:array[0..1] of string[7]=('_OUTPUT','_INPUT');
-          var     r : preference;
-
-            begin
-                 new(r);
-                 reset_reference(r^);
-                 r^.symbol:=stringdup('U_'+upper(target_info.system_unit)+io[byte(doread)]);
-                 if assem_need_external_list and
-                   not (cs_compilesystem in aktswitches) then
-                 concat_external(r^.symbol^,EXT_NEAR);
-
-                 exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,r,R_EDI)))
-            end;
+          const
+            io:array[0..1] of string[7]=('_OUTPUT','_INPUT');
+          var
+            r : preference;
+          begin
+            new(r);
+            reset_reference(r^);
+            r^.symbol:=stringdup('U_'+upper(target_info.system_unit)+io[byte(doread)]);
+{           if not (cs_compilesystem in aktswitches) then }
+              concat_external(r^.symbol^,EXT_NEAR);
+            exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,r,R_EDI)))
+          end;
 
         var
-             node,hp : ptree;
-            typedtyp,pararesult : pdef;
+           node,hp : ptree;
+           typedtyp,pararesult : pdef;
            doflush,has_length : boolean;
            dummycoll : tdefcoll;
            iolabel : plabel;
@@ -4253,7 +4081,7 @@ implementation
                           p^.location.register)
                       else
                       if p^.left^.location.loc=LOC_FLAGS then
-                        exprasmlist^.concat(new(pai386,op_reg(flag_2_set[p^.left^.location.resflags],S_NO,
+                        exprasmlist^.concat(new(pai386,op_reg(flag_2_set[p^.left^.location.resflags],S_B,
                                   p^.location.register)))
                       else
                         begin
@@ -5416,7 +5244,7 @@ implementation
                  LOC_CREGISTER,
                  LOC_REGISTER : is_mem:=false;
                      LOC_FLAGS : begin
-                                exprasmlist^.concat(new(pai386,op_reg(flag_2_set[p^.right^.location.resflags],S_NO,R_AL)));
+                                exprasmlist^.concat(new(pai386,op_reg(flag_2_set[p^.right^.location.resflags],S_B,R_AL)));
                                         goto do_jmp;
                              end;
                  LOC_JUMP : begin
@@ -5738,7 +5566,7 @@ do_jmp:
       begin
          getlabel(endlabel);
          getlabel(elselabel);
-         if smartlink then
+         if (cs_smartlink in aktswitches) then
            jumpsegment:=procinfo.aktlocaldata
          else
            jumpsegment:=datasegment;
@@ -5812,11 +5640,11 @@ do_jmp:
                    else
                      max_linear_list:=2;
                    { a jump table crashes the pipeline! }
-                   if opt_processors=i486 then
+                   if aktoptprocessor=i486 then
                      inc(max_linear_list,3);
-                       if opt_processors=pentium then
+                       if aktoptprocessor=pentium then
                      inc(max_linear_list,6);
-                   if opt_processors>=pentiumpro then
+                   if aktoptprocessor>=pentiumpro then
                      inc(max_linear_list,9);
 
                    if (labels<=max_linear_list) then
@@ -6370,7 +6198,14 @@ do_jmp:
 end.
 {
   $Log$
-  Revision 1.25  1998-05-21 19:33:31  peter
+  Revision 1.26  1998-05-23 01:21:03  peter
+    + aktasmmode, aktoptprocessor, aktoutputformat
+    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
+    + $LIBNAME to set the library name where the unit will be put in
+    * splitted cgi386 a bit (codeseg to large for bp7)
+    * nasm, tasm works again. nasm moved to ag386nsm.pas
+
+  Revision 1.25  1998/05/21 19:33:31  peter
     + better procedure directive handling and only one table
 
   Revision 1.24  1998/05/20 09:42:33  pierre

compiler/files.pas

@@ -104,7 +104,6 @@ unit files;
           unitcount     : word;     { local unit counter }
           unit_index    : word;     { global counter for browser }
           symtable      : pointer;  { pointer to the psymtable of this unit }
-          output_format : tof;      { how to write this file }
 
           uses_imports  : boolean;  { Set if the module imports from DLL's.}
           imports       : plinkedlist;
@@ -118,11 +117,11 @@ unit files;
           { used in firstpass for faster settings }
           current_index : word;
 
-          unitname,                 { name of the (unit) module in uppercase }
+          modulename,               { name of the module in uppercase }
           objfilename,              { fullname of the objectfile }
           asmfilename,              { fullname of the assemblerfile }
           ppufilename,              { fullname of the ppufile }
-          arfilename,               { fullname of the archivefile }
+          libfilename,              { fullname of the libraryfile }
           mainsource    : pstring;  { name of the main sourcefile }
 
           constructor init(const s:string;_is_unit:boolean);
@@ -273,7 +272,7 @@ unit files;
 
       begin
         if Use_Rhide then
-          get_file_line:=lowercase(bstoslash(path^)+name^+ext^)+':'+tostr(line_no)+':'
+          get_file_line:=lower(bstoslash(path^)+name^+ext^)+':'+tostr(line_no)+':'
         else
           get_file_line:=name^+ext^+'('+tostr(line_no)+')'
       end;
@@ -350,12 +349,12 @@ unit files;
          stringdispose(objfilename);
          stringdispose(asmfilename);
          stringdispose(ppufilename);
-         stringdispose(arfilename);
+         stringdispose(libfilename);
          s:=FixFileName(FixPath(path)+name);
          objfilename:=stringdup(s+target_info.objext);
          asmfilename:=stringdup(s+target_info.asmext);
          ppufilename:=stringdup(s+target_info.unitext);
-         arfilename:=stringdup(s+target_os.staticlibext);
+         libfilename:=stringdup(s+target_os.staticlibext);
       end;
 
 {$ifdef NEWPPU}
@@ -665,8 +664,8 @@ unit files;
        begin
          ppufile^.read_data(hs[0],1,count);
          ppufile^.read_data(hs[1],ord(hs[0]),count);
-         stringdispose(unitname);
-         unitname:=stringdup(hs);
+         stringdispose(modulename);
+         modulename:=stringdup(hs);
          ppufile^.read_data(b,1,count);
        end;
 
@@ -730,7 +729,7 @@ unit files;
     { check the object and assembler file if not a library }
       if (flags and uf_smartlink)<>0 then
        begin
-         objfiletime:=getnamedfiletime(arfilename^);
+         objfiletime:=getnamedfiletime(libfilename^);
          if (ppufiletime<0) or (objfiletime<0) or (ppufiletime>objfiletime) then
            do_compile:=true;
        end
@@ -848,11 +847,11 @@ unit files;
         e : extstr;
       begin
          FSplit(s,p,n,e);
-         unitname:=stringdup(Upper(n));
+         modulename:=stringdup(Upper(n));
          mainsource:=stringdup(s);
          objfilename:=nil;
          asmfilename:=nil;
-         arfilename:=nil;
+         libfilename:=nil;
          ppufilename:=nil;
          setfilename(p,n);
          used_units.init;
@@ -878,13 +877,12 @@ unit files;
          is_unit:=_is_unit;
          uses_imports:=false;
          imports:=new(plinkedlist,init);
-         output_format:=commandline_output_format;
        { set smartlink flag }
-         if smartlink then
+         if (cs_smartlink in aktswitches) then
           flags:=flags or uf_smartlink;
        { search the PPU file if it is an unit }
          if is_unit then
-          search_unit(unitname^);
+          search_unit(modulename^);
       end;
 
     destructor tmodule.special_done;
@@ -929,7 +927,14 @@ unit files;
 end.
 {
   $Log$
-  Revision 1.12  1998-05-20 09:42:33  pierre
+  Revision 1.13  1998-05-23 01:21:05  peter
+    + aktasmmode, aktoptprocessor, aktoutputformat
+    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
+    + $LIBNAME to set the library name where the unit will be put in
+    * splitted cgi386 a bit (codeseg to large for bp7)
+    * nasm, tasm works again. nasm moved to ag386nsm.pas
+
+  Revision 1.12  1998/05/20 09:42:33  pierre
     + UseTokenInfo now default
     * unit in interface uses and implementation uses gives error now
     * only one error for unknown symbol (uses lastsymknown boolean)

compiler/hcodegen.pas

@@ -121,8 +121,6 @@ unit hcodegen;
     procedure codegen_newmodule;
     procedure codegen_newprocedure;
 
-
-
     { counts the labels }
     function case_count_labels(root : pcaserecord) : longint;
     { searches the highest label }
@@ -130,7 +128,6 @@ unit hcodegen;
     { searches the lowest label }
     function case_get_min(root : pcaserecord) : longint;
 
-
     { concates/inserts the ASCII string to the data segment }
     procedure generate_ascii(const hs : string);
     procedure generate_ascii_insert(const hs : string);
@@ -140,7 +137,6 @@ unit hcodegen;
     procedure generate_pascii(hs : pchar;length : longint);
     procedure generate_pascii_insert(hs : pchar;length : longint);
 
-
     { convert/concats a label for constants in the consts section }
     function constlabel2str(l : plabel;ctype:tconsttype):string;
     function constlabelnb2str(pnb : longint;ctype:tconsttype):string;
@@ -150,7 +146,7 @@ unit hcodegen;
 implementation
 
      uses
-        systems,cobjects,globals,files,strings;
+        systems,cobjects,verbose,globals,files,strings;
 
 {*****************************************************************************
          initialize/terminate the codegen for procedure and modules
@@ -219,7 +215,7 @@ implementation
           dispose(resourcesection,done);
       end;
 
-        
+
 {*****************************************************************************
                               Case Helpers
 *****************************************************************************}
@@ -292,7 +288,6 @@ implementation
       end;
 
 
-
     { concates the ASCII string from pchar to the const segment }
     procedure generate_pascii(hs : pchar;length : longint);
       var
@@ -347,7 +342,6 @@ implementation
            end;
       end;
 
-
 {*****************************************************************************
                               Const Helpers
 *****************************************************************************}
@@ -360,16 +354,16 @@ implementation
       { we must use the number directly !!! (PM) }
     function constlabel2str(l : plabel;ctype:tconsttype):string;
       begin
-        if smartlink or (current_module^.output_format in [of_nasm,of_obj]) then
-         constlabel2str:='_$'+current_module^.unitname^+'$'+consttypestr[ctype]+'_const_'+tostr(l^.nb)
+        if (cs_smartlink in aktswitches) or (aktoutputformat in [as_tasm]) then
+         constlabel2str:='_$'+current_module^.modulename^+'$'+consttypestr[ctype]+'_const_'+tostr(l^.nb)
         else
          constlabel2str:=lab2str(l);
       end;
 
     function constlabelnb2str(pnb : longint;ctype:tconsttype):string;
       begin
-        if smartlink or (current_module^.output_format in [of_nasm,of_obj]) then
-         constlabelnb2str:='_$'+current_module^.unitname^+'$'+consttypestr[ctype]+'_const_'+tostr(pnb)
+        if (cs_smartlink in aktswitches) or (aktoutputformat in [as_tasm]) then
+         constlabelnb2str:='_$'+current_module^.modulename^+'$'+consttypestr[ctype]+'_const_'+tostr(pnb)
         else
          constlabelnb2str:=target_asm.labelprefix+tostr(pnb);
       end;
@@ -379,10 +373,10 @@ implementation
       var
         s : string;
       begin
-        if smartlink or (current_module^.output_format in [of_nasm,of_obj]) then
+        if (cs_smartlink in aktswitches) or (aktoutputformat in [as_tasm]) then
          begin
-           s:='_$'+current_module^.unitname^+'$'+consttypestr[ctype]+'_const_'+tostr(p^.nb);
-           if smartlink then
+           s:='_$'+current_module^.modulename^+'$'+consttypestr[ctype]+'_const_'+tostr(p^.nb);
+           if (cs_smartlink in aktswitches) then
             begin
               consts^.concat(new(pai_cut,init));
               consts^.concat(new(pai_symbol,init_global(s)))
@@ -398,7 +392,14 @@ end.
 
 {
   $Log$
-  Revision 1.5  1998-05-20 09:42:34  pierre
+  Revision 1.6  1998-05-23 01:21:08  peter
+    + aktasmmode, aktoptprocessor, aktoutputformat
+    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
+    + $LIBNAME to set the library name where the unit will be put in
+    * splitted cgi386 a bit (codeseg to large for bp7)
+    * nasm, tasm works again. nasm moved to ag386nsm.pas
+
+  Revision 1.5  1998/05/20 09:42:34  pierre
     + UseTokenInfo now default
     * unit in interface uses and implementation uses gives error now
     * only one error for unknown symbol (uses lastsymknown boolean)

compiler/i386.pas

@@ -25,7 +25,7 @@ unit i386;
   interface
 
     uses
-       strings,systems,cobjects,globals,aasm,files,verbose;
+      cobjects,aasm;
 
     const
       extended_size = 10;
@@ -294,12 +294,9 @@ unit i386;
 
     const
        maxvarregs = 4;
-
        varregs : array[1..maxvarregs] of tregister =
          (R_EBX,R_EDX,R_ECX,R_EAX);
 
-       nextlabelnr : longint = 1;
-
     { the following functions allow to convert registers }
     { for example reg8toreg32(R_AL) returns R_EAX        }
     { for example reg16toreg32(R_AL) gives an undefined  }
@@ -321,17 +318,6 @@ unit i386;
     { use this only for already used references       }
     procedure clear_reference(var ref : treference);
 
-    { make l as a new label }
-    procedure getlabel(var l : plabel);
-    { frees the label if unused }
-    procedure freelabel(var l : plabel);
-    { make a new zero label }
-    procedure getzerolabel(var l : plabel);
-    { reset a label to a zero label }
-    procedure setzerolabel(var l : plabel);
-    {just get a label number }
-    procedure getlabelnr(var l : longint);
-
     function newreference(const r : treference) : preference;
 
     function reg2str(r : tregister) : string;
@@ -339,8 +325,6 @@ unit i386;
     { generates an help record for constants }
     function newcsymbol(const s : string;l : longint) : pcsymbol;
 
-    function lab2str(l : plabel) : string;
-
     const
        ao_unknown = $0;
        { 8 bit reg }
@@ -1075,23 +1059,24 @@ unit i386;
 
   implementation
 
-    function reg2str(r : tregister) : string;
+    uses
+      strings,globals,verbose;
+
 
+    function reg2str(r : tregister) : string;
       const
          a : array[R_NO..R_BL] of string[3] =
           ('','EAX','ECX','EDX','EBX','ESP','EBP','ESI','EDI',
            'AX','CX','DX','BX','SP','BP','SI','DI',
            'AL','CL','DL','BL');
-
       begin
          reg2str:=a[r];
       end;
 
-    function newreference(const r : treference) : preference;
 
+    function newreference(const r : treference) : preference;
       var
          p : preference;
-
       begin
          new(p);
          p^:=r;
@@ -1100,25 +1085,6 @@ unit i386;
          newreference:=p;
       end;
 
-    function lab2str(l : plabel) : string;
-
-      begin
-         if (l=nil) or (l^.nb=0) then
-{$ifdef EXTDEBUG}
-           lab2str:='ILLEGAL'
-         else
-         begin
-            lab2str:=target_asm.labelprefix+tostr(l^.nb);
-         end;
-{$else EXTDEBUG}
-           internalerror(2000);
-           lab2str:=target_asm.labelprefix+tostr(l^.nb);
-{$endif EXTDEBUG}
-         { was missed: }
-         inc(l^.refcount);
-         l^.is_used:=true;
-      end;
-
     function reg8toreg16(reg : tregister) : tregister;
 
       begin
@@ -1199,51 +1165,6 @@ unit i386;
          reset_reference(ref);
       end;
 
-    procedure getlabel(var l : plabel);
-
-      begin
-         new(l);
-         l^.nb:=nextlabelnr;
-         l^.is_used:=false;
-         l^.is_set:=false;
-         l^.refcount:=0;
-         inc(nextlabelnr);
-      end;
-
-    procedure freelabel(var l : plabel);
-
-      begin
-         if (l<>nil) and (not l^.is_set) and (not l^.is_used) then
-           dispose(l);
-         l:=nil;
-      end;
-
-    procedure setzerolabel(var l : plabel);
-
-      begin
-         l^.nb:=0;
-         l^.is_used:=false;
-         l^.is_set:=false;
-         l^.refcount:=0;
-      end;
-
-    procedure getzerolabel(var l : plabel);
-
-      begin
-         new(l);
-         l^.nb:=0;
-         l^.is_used:=false;
-         l^.is_set:=false;
-         l^.refcount:=0;
-      end;
-
-    procedure getlabelnr(var l : longint);
-
-      begin
-         l:=nextlabelnr;
-         inc(nextlabelnr);
-      end;
-
     function newcsymbol(const s : string;l : longint) : pcsymbol;
 
       var
@@ -1793,7 +1714,14 @@ unit i386;
 end.
 {
   $Log$
-  Revision 1.7  1998-05-20 09:42:34  pierre
+  Revision 1.8  1998-05-23 01:21:09  peter
+    + aktasmmode, aktoptprocessor, aktoutputformat
+    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
+    + $LIBNAME to set the library name where the unit will be put in
+    * splitted cgi386 a bit (codeseg to large for bp7)
+    * nasm, tasm works again. nasm moved to ag386nsm.pas
+
+  Revision 1.7  1998/05/20 09:42:34  pierre
     + UseTokenInfo now default
     * unit in interface uses and implementation uses gives error now
     * only one error for unknown symbol (uses lastsymknown boolean)

compiler/m68k.pas

@@ -26,7 +26,7 @@ unit m68k;
   interface
 
     uses
-       strings,systems,cobjects,globals,aasm,verbose;
+       cobjects,aasm;
 
     const
       { if real fpu is used }
@@ -34,7 +34,6 @@ unit m68k;
       { s32real.            }
       extended_size = 12;
 
-
     type
     {  warning: CPU32 opcodes are not fully compatible with the MC68020. }
        { 68000 only opcodes }
@@ -347,11 +346,8 @@ type
 
     const
        maxvarregs = 5;
-
        varregs : array[1..maxvarregs] of tregister =
-     (R_D2,R_D3,R_D4,R_D5,R_D7);
-
-       nextlabelnr : longint = 1;
+        (R_D2,R_D3,R_D4,R_D5,R_D7);
 
 
     { resets all values of ref to defaults }
@@ -361,17 +357,6 @@ type
     { use this only for already used references       }
     procedure clear_reference(var ref : treference);
 
-    { make l as a new label }
-    procedure getlabel(var l : plabel);
-    { frees the label if unused }
-    procedure freelabel(var l : plabel);
-    { make a new zero label }
-    procedure getzerolabel(var l : plabel);
-    { reset a label to a zero label }
-    procedure setzerolabel(var l : plabel);
-    {just get a label number }
-    procedure getlabelnr(var l : longint);
-
     function newreference(const r : treference) : preference;
 
     function reg2str(r : tregister) : string;
@@ -379,8 +364,6 @@ type
     { generates an help record for constants }
     function newcsymbol(const s : string;l : longint) : pcsymbol;
 
-    function lab2str(l : plabel) : string;
-
     const
        ao_unknown = $0;
        { 8 bit reg }
@@ -868,6 +851,9 @@ type
 
   implementation
 
+    uses
+      strings,globals,verbose;
+
     function reg2str(r : tregister) : string;
 
       const
@@ -896,23 +882,6 @@ type
      newreference:=p;
       end;
 
-    function lab2str(l : plabel) : string;
-
-      begin
-         if (l=nil) or (l^.nb=0) then
-{$ifdef EXTDEBUG}
-           lab2str:='ILLEGAL'
-         else
-           lab2str:=target_asm.labelprefix+tostr(l^.nb);
-{$else EXTDEBUG}
-           internalerror(2000);
-         lab2str:=target_asm.labelprefix+tostr(l^.nb);
-{$endif EXTDEBUG}
-
-         l^.is_used:=true;
-      end;
-
-
     procedure reset_reference(var ref : treference);
 
       begin
@@ -936,51 +905,6 @@ type
      reset_reference(ref);
       end;
 
-    procedure getlabel(var l : plabel);
-
-      begin
-     new(l);
-     l^.nb:=nextlabelnr;
-     l^.is_used:=false;
-     l^.is_set:=false;
-     l^.refcount:=0;
-     inc(nextlabelnr);
-      end;
-
-    procedure freelabel(var l : plabel);
-
-      begin
-     if (l<>nil) and (not l^.is_set) and (not l^.is_used) then
-       dispose(l);
-     l:=nil;
-      end;
-
-    procedure setzerolabel(var l : plabel);
-
-      begin
-     l^.nb:=0;
-     l^.is_used:=false;
-     l^.is_set:=false;
-     l^.refcount:=0;
-      end;
-
-    procedure getzerolabel(var l : plabel);
-
-      begin
-     new(l);
-     l^.nb:=0;
-     l^.is_used:=false;
-     l^.is_set:=false;
-     l^.refcount:=0;
-      end;
-
-    procedure getlabelnr(var l : longint);
-
-      begin
-     l:=nextlabelnr;
-     inc(nextlabelnr);
-      end;
-
     function newcsymbol(const s : string;l : longint) : pcsymbol;
 
       var
@@ -1642,7 +1566,14 @@ type
 end.
 {
   $Log$
-  Revision 1.3  1998-05-11 13:07:54  peter
+  Revision 1.4  1998-05-23 01:21:10  peter
+    + aktasmmode, aktoptprocessor, aktoutputformat
+    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
+    + $LIBNAME to set the library name where the unit will be put in
+    * splitted cgi386 a bit (codeseg to large for bp7)
+    * nasm, tasm works again. nasm moved to ag386nsm.pas
+
+  Revision 1.3  1998/05/11 13:07:54  peter
     + $ifdef NEWPPU for the new ppuformat
     + $define GDB not longer required
     * removed all warnings and stripped some log comments

compiler/optione.msg

@@ -122,11 +122,12 @@ Report bugs,suggestions etc to:
 **2Xs_strip all symbols from executable
 **0*_Processor specific options:
 3*1A_output format
-3*2Aatt_AT&T assembler
 3*2Ao_coff file using GNU AS
-3*2Aobj_OMF file using NASM
-3*2Anasm_coff file using NASM
-3*2Amasm_assembler for the Microsoft/Borland/Watcom assembler
+3*2Anasmcoff_coff file using Nasm
+3*2Anasmelf_elf32 (linux) file using Nasm
+3*2Anasmobj_obj file using Nasm
+3*2Amasm_obj using Masm (Mircosoft)
+3*2Atasm_obj using Tasm (Borland)
 3*1R_assembler reading style
 3*2Ratt_read AT&T style assembler
 3*2Rintel_read Intel style assembler
@@ -145,10 +146,10 @@ Report bugs,suggestions etc to:
 3*2O7_optimize for the Cyrix 6x86
 3*2O8_optimize for the AMD K6
 6*1A_output format
+6*2Ao_Unix o-file using GNU AS
 6*2Agas_GNU Motorola assembler
-6*2Ao_UNIX o-file
-6*2Am_Standard Motorola assembler
-6*2Ai_MIT Syntax (old GAS)
+6*2Amit_MIT Syntax (old GAS)
+6*2Amot_Standard Motorola assembler
 6*1O_optimizations
 6*2Oa_simple optimizations
 6*2Og_optimize for size

compiler/optmsg.inc

@@ -1,4 +1,4 @@
-const optiontxt : array[1..04827] of char=(
+const optiontxt : array[1..04879] of char=(
   ' ','[','o','p','t','i','o','n','s',']',' ','<','i','n','p',
   'u','t','f','i','l','e','>',' ','[','o','p','t','i','o','n',
   's',']',#000,'O','n','l','y',' ','o','n','e',' ','s','o','u',
@@ -42,14 +42,14 @@ const optiontxt : array[1..04827] of char=(
   '9','8',' ','b','y',' ','F','l','o','r','i','a','n',' ','K',
   'l','a','e','m','p','f','l',#000,'F','r','e','e',' ','P','a',
   's','c','a','l',' ','C','o','m','p','i','l','e','r',' ','v',
-  'e','r','s','i','o','n',' ','$','V','E','R',#000,#000,'l','f',
-  '>',#010,'T','h','i','s',' ','p','r','o','g','r','a','m',' ',
+  'e','r','s','i','o','n',' ','$','V','E','R',#000,'<','l','f',
+  '>',#000,'T','h','i','s',' ','p','r','o','g','r','a','m',' ',
   'c','o','m','e','s',' ','u','n','d','e','r',' ','t','h','e',
   ' ','G','N','U',' ','G','e','n','e','r','a','l',' ','P','u',
   'b','l','i','c',' ','L','i','c','e','n','c','e',#000,'F','o',
   'r',' ','m','o','r','e',' ','i','n','f','o','r','m','a','t',
   'i','o','n',' ','r','e','a','d',' ','C','O','P','Y','I','N',
-  'G',#000,#000,'l','f','>',#010,'R','e','p','o','r','t',' ','b',
+  'G',#000,'<','l','f','>',#000,'R','e','p','o','r','t',' ','b',
   'u','g','s',',','s','u','g','g','e','s','t','i','o','n','s',
   ' ','e','t','c',' ','t','o',':',#000,' ',' ',' ',' ',' ',' ',
   ' ',' ',' ',' ',' ',' ',' ',' ',' ',' ','b','a','2','3','9',
@@ -250,74 +250,78 @@ const optiontxt : array[1..04827] of char=(
   's','s','o','r',' ','s','p','e','c','i','f','i','c',' ','o',
   'p','t','i','o','n','s',':',#000,'3','*','1','A','_','o','u',
   't','p','u','t',' ','f','o','r','m','a','t',#000,'3','*','2',
-  'A','a','t','t','_','A','T','&','T',' ','a','s','s','e','m',
-  'b','l','e','r',#000,'3','*','2','A','o','_','c','o','f','f',
-  ' ','f','i','l','e',' ','u','s','i','n','g',' ','G','N','U',
-  ' ','A','S',#000,'3','*','2','A','o','b','j','_','O','M','F',
-  ' ','f','i','l','e',' ','u','s','i','n','g',' ','N','A','S',
-  'M',#000,'3','*','2','A','n','a','s','m','_','c','o','f','f',
-  ' ','f','i','l','e',' ','u','s','i','n','g',' ','N','A','S',
-  'M',#000,'3','*','2','A','m','a','s','m','_','a','s','s','e',
-  'm','b','l','e','r',' ','f','o','r',' ','t','h','e',' ','M',
-  'i','c','r','o','s','o','f','t','/','B','o','r','l','a','n',
-  'd','/','W','a','t','c','o','m',' ','a','s','s','e','m','b',
-  'l','e','r',#000,'3','*','1','R','_','a','s','s','e','m','b',
-  'l','e','r',' ','r','e','a','d','i','n','g',' ','s','t','y',
-  'l','e',#000,'3','*','2','R','a','t','t','_','r','e','a','d',
-  ' ','A','T','&','T',' ','s','t','y','l','e',' ','a','s','s',
-  'e','m','b','l','e','r',#000,'3','*','2','R','i','n','t','e',
-  'l','_','r','e','a','d',' ','I','n','t','e','l',' ','s','t',
-  'y','l','e',' ','a','s','s','e','m','b','l','e','r',#000,'3',
-  '*','2','R','d','i','r','e','c','t','_','c','o','p','y',' ',
-  'a','s','s','e','m','b','l','e','r',' ','t','e','x','t',' ',
-  'd','i','r','e','c','t','l','y',' ','t','o',' ','a','s','s',
-  'e','m','b','l','e','r',' ','f','i','l','e',#000,'3','*','1',
-  'O','_','o','p','t','i','m','i','z','a','t','i','o','n','s',
-  #000,'3','*','2','O','a','_','s','i','m','p','l','e',' ','o',
-  'p','t','i','m','i','z','a','t','i','o','n','s',#000,'3','*',
-  '2','O','g','_','o','p','t','i','m','i','z','e',' ','f','o',
-  'r',' ','s','i','z','e',#000,'3','*','2','O','G','_','o','p',
-  't','i','m','i','z','e',' ','f','o','r',' ','t','i','m','e',
-  #000,'3','*','2','O','x','_','o','p','t','i','m','i','z','e',
-  ' ','m','a','x','i','m','u','m',#000,'3','*','2','O','z','_',
-  'u','n','c','e','r','t','a','i','n',' ','o','p','t','i','m',
-  'i','z','e','s',' ','(','s','e','e',' ','d','o','c','s',')',
-  #000,'3','*','2','O','2','_','o','p','t','i','m','i','z','e',
-  ' ','f','o','r',' ','t','h','e',' ','P','e','n','t','i','u',
-  'm',' ','I','I',' ','(','t','m',')',#000,'3','*','2','O','3',
-  '_','o','p','t','i','m','i','z','e',' ','f','o','r',' ','t',
-  'h','e',' ','i','3','8','6',#000,'3','*','2','O','4','_','o',
-  'p','t','i','m','i','z','e',' ','f','o','r',' ','t','h','e',
-  ' ','i','4','8','6',#000,'3','*','2','O','5','_','o','p','t',
+  'A','o','_','c','o','f','f',' ','f','i','l','e',' ','u','s',
+  'i','n','g',' ','G','N','U',' ','A','S',#000,'3','*','2','A',
+  'n','a','s','m','c','o','f','f','_','c','o','f','f',' ','f',
+  'i','l','e',' ','u','s','i','n','g',' ','N','a','s','m',#000,
+  '3','*','2','A','n','a','s','m','e','l','f','_','e','l','f',
+  '3','2',' ','(','l','i','n','u','x',')',' ','f','i','l','e',
+  ' ','u','s','i','n','g',' ','N','a','s','m',#000,'3','*','2',
+  'A','n','a','s','m','o','b','j','_','o','b','j',' ','f','i',
+  'l','e',' ','u','s','i','n','g',' ','N','a','s','m',#000,'3',
+  '*','2','A','m','a','s','m','_','o','b','j',' ','u','s','i',
+  'n','g',' ','M','a','s','m',' ','(','M','i','r','c','o','s',
+  'o','f','t',')',#000,'3','*','2','A','t','a','s','m','_','o',
+  'b','j',' ','u','s','i','n','g',' ','T','a','s','m',' ','(',
+  'B','o','r','l','a','n','d',')',#000,'3','*','1','R','_','a',
+  's','s','e','m','b','l','e','r',' ','r','e','a','d','i','n',
+  'g',' ','s','t','y','l','e',#000,'3','*','2','R','a','t','t',
+  '_','r','e','a','d',' ','A','T','&','T',' ','s','t','y','l',
+  'e',' ','a','s','s','e','m','b','l','e','r',#000,'3','*','2',
+  'R','i','n','t','e','l','_','r','e','a','d',' ','I','n','t',
+  'e','l',' ','s','t','y','l','e',' ','a','s','s','e','m','b',
+  'l','e','r',#000,'3','*','2','R','d','i','r','e','c','t','_',
+  'c','o','p','y',' ','a','s','s','e','m','b','l','e','r',' ',
+  't','e','x','t',' ','d','i','r','e','c','t','l','y',' ','t',
+  'o',' ','a','s','s','e','m','b','l','e','r',' ','f','i','l',
+  'e',#000,'3','*','1','O','_','o','p','t','i','m','i','z','a',
+  't','i','o','n','s',#000,'3','*','2','O','a','_','s','i','m',
+  'p','l','e',' ','o','p','t','i','m','i','z','a','t','i','o',
+  'n','s',#000,'3','*','2','O','g','_','o','p','t','i','m','i',
+  'z','e',' ','f','o','r',' ','s','i','z','e',#000,'3','*','2',
+  'O','G','_','o','p','t','i','m','i','z','e',' ','f','o','r',
+  ' ','t','i','m','e',#000,'3','*','2','O','x','_','o','p','t',
+  'i','m','i','z','e',' ','m','a','x','i','m','u','m',#000,'3',
+  '*','2','O','z','_','u','n','c','e','r','t','a','i','n',' ',
+  'o','p','t','i','m','i','z','e','s',' ','(','s','e','e',' ',
+  'd','o','c','s',')',#000,'3','*','2','O','2','_','o','p','t',
   'i','m','i','z','e',' ','f','o','r',' ','t','h','e',' ','P',
-  'e','n','t','i','u','m',' ','(','t','m',')',#000,'3','*','2',
-  'O','6','_','o','p','t','i','m','i','z','e',' ','f','o','r',
-  ' ','t','h','e',' ','P','e','n','t','i','u','m','P','r','o',
-  ' ','(','t','m',')',#000,'3','*','2','O','7','_','o','p','t',
-  'i','m','i','z','e',' ','f','o','r',' ','t','h','e',' ','C',
-  'y','r','i','x',' ','6','x','8','6',#000,'3','*','2','O','8',
-  '_','o','p','t','i','m','i','z','e',' ','f','o','r',' ','t',
-  'h','e',' ','A','M','D',' ','K','6',#000,'6','*','1','A','_',
-  'o','u','t','p','u','t',' ','f','o','r','m','a','t',#000,'6',
-  '*','2','A','g','a','s','_','G','N','U',' ','M','o','t','o',
-  'r','o','l','a',' ','a','s','s','e','m','b','l','e','r',#000,
-  '6','*','2','A','o','_','U','N','I','X',' ','o','-','f','i',
-  'l','e',#000,'6','*','2','A','m','_','S','t','a','n','d','a',
-  'r','d',' ','M','o','t','o','r','o','l','a',' ','a','s','s',
-  'e','m','b','l','e','r',#000,'6','*','2','A','i','_','M','I',
-  'T',' ','S','y','n','t','a','x',' ','(','o','l','d',' ','G',
-  'A','S',')',#000,'6','*','1','O','_','o','p','t','i','m','i',
-  'z','a','t','i','o','n','s',#000,'6','*','2','O','a','_','s',
-  'i','m','p','l','e',' ','o','p','t','i','m','i','z','a','t',
-  'i','o','n','s',#000,'6','*','2','O','g','_','o','p','t','i',
-  'm','i','z','e',' ','f','o','r',' ','s','i','z','e',#000,'6',
-  '*','2','O','G','_','o','p','t','i','m','i','z','e',' ','f',
-  'o','r',' ','t','i','m','e',#000,'6','*','2','O','x','_','o',
-  'p','t','i','m','i','z','e',' ','m','a','x','i','m','u','m',
-  #000,'6','*','2','O','2','_','t','a','r','g','e','t',' ','i',
-  's',' ','a',' ','M','C','6','8','0','2','0','+',' ','p','r',
-  'o','c','e','s','s','o','r',#000,'*','*','1','*','_',#000,'*',
-  '*','1','?','_','s','h','o','w','s',' ','t','h','i','s',' ',
-  'h','e','l','p',#000,'*','*','1','h','_','s','h','o','w','s',
-  ' ','t','h','i','s',' ','h','e','l','p',' ','w','i','t','h',
-  'o','u','t',' ','w','a','i','t','i','n','g',#000);
+  'e','n','t','i','u','m',' ','I','I',' ','(','t','m',')',#000,
+  '3','*','2','O','3','_','o','p','t','i','m','i','z','e',' ',
+  'f','o','r',' ','t','h','e',' ','i','3','8','6',#000,'3','*',
+  '2','O','4','_','o','p','t','i','m','i','z','e',' ','f','o',
+  'r',' ','t','h','e',' ','i','4','8','6',#000,'3','*','2','O',
+  '5','_','o','p','t','i','m','i','z','e',' ','f','o','r',' ',
+  't','h','e',' ','P','e','n','t','i','u','m',' ','(','t','m',
+  ')',#000,'3','*','2','O','6','_','o','p','t','i','m','i','z',
+  'e',' ','f','o','r',' ','t','h','e',' ','P','e','n','t','i',
+  'u','m','P','r','o',' ','(','t','m',')',#000,'3','*','2','O',
+  '7','_','o','p','t','i','m','i','z','e',' ','f','o','r',' ',
+  't','h','e',' ','C','y','r','i','x',' ','6','x','8','6',#000,
+  '3','*','2','O','8','_','o','p','t','i','m','i','z','e',' ',
+  'f','o','r',' ','t','h','e',' ','A','M','D',' ','K','6',#000,
+  '6','*','1','A','_','o','u','t','p','u','t',' ','f','o','r',
+  'm','a','t',#000,'6','*','2','A','o','_','U','n','i','x',' ',
+  'o','-','f','i','l','e',' ','u','s','i','n','g',' ','G','N',
+  'U',' ','A','S',#000,'6','*','2','A','g','a','s','_','G','N',
+  'U',' ','M','o','t','o','r','o','l','a',' ','a','s','s','e',
+  'm','b','l','e','r',#000,'6','*','2','A','m','i','t','_','M',
+  'I','T',' ','S','y','n','t','a','x',' ','(','o','l','d',' ',
+  'G','A','S',')',#000,'6','*','2','A','m','o','t','_','S','t',
+  'a','n','d','a','r','d',' ','M','o','t','o','r','o','l','a',
+  ' ','a','s','s','e','m','b','l','e','r',#000,'6','*','1','O',
+  '_','o','p','t','i','m','i','z','a','t','i','o','n','s',#000,
+  '6','*','2','O','a','_','s','i','m','p','l','e',' ','o','p',
+  't','i','m','i','z','a','t','i','o','n','s',#000,'6','*','2',
+  'O','g','_','o','p','t','i','m','i','z','e',' ','f','o','r',
+  ' ','s','i','z','e',#000,'6','*','2','O','G','_','o','p','t',
+  'i','m','i','z','e',' ','f','o','r',' ','t','i','m','e',#000,
+  '6','*','2','O','x','_','o','p','t','i','m','i','z','e',' ',
+  'm','a','x','i','m','u','m',#000,'6','*','2','O','2','_','t',
+  'a','r','g','e','t',' ','i','s',' ','a',' ','M','C','6','8',
+  '0','2','0','+',' ','p','r','o','c','e','s','s','o','r',#000,
+  '*','*','1','*','_',#000,'*','*','1','?','_','s','h','o','w',
+  's',' ','t','h','i','s',' ','h','e','l','p',#000,'*','*','1',
+  'h','_','s','h','o','w','s',' ','t','h','i','s',' ','h','e',
+  'l','p',' ','w','i','t','h','o','u','t',' ','w','a','i','t',
+  'i','n','g',#000);

compiler/opts386.pas

@@ -39,51 +39,14 @@ uses
 
 procedure toption386.interpret_proc_specific_options(const opt:string);
 var
-  j : longint;
+  j     : longint;
+  More  : string;
 begin
+  More:=Upper(copy(opt,3,length(opt)-2));
   case opt[2] of
    'A' : begin
-           if copy(opt,3,length(opt)-2)='o' then
-            begin
-              output_format:=of_o;
-              assem_need_external_list:=false;
-            end
-           else
-            if copy(opt,3,length(opt)-2)='masm' then
-             begin
-               output_format:=of_masm;
-               assem_need_external_list:=true;
-             end
-           else
-            if copy(opt,3,length(opt)-2)='att' then
-             begin
-               output_format:=of_att;
-               assem_need_external_list:=false;
-             end
-           else
-            if copy(opt,3,length(opt)-2)='win32' then
-             begin
-               output_format:=of_win32;
-               assem_need_external_list:=false;
-             end
-           else
-           { nasm supports local labels but
-             only inside one global label :
-             this does not work for const strings and
-             real references !! }
-            if copy(opt,3,length(opt)-2)='obj' then
-             begin
-               output_format:=of_obj;
-               assem_need_external_list:=true;
-               { target_info.labelprefix:='?L'; }
-             end
-           else
-            if copy(opt,3,length(opt)-2)='nasm' then
-             begin
-               output_format:=of_nasm;
-               assem_need_external_list:=true;
-               { target_info.labelprefix:='?L'; }
-             end
+           if set_string_asm(More) then
+            initoutputformat:=target_asm.id
            else
             IllegalPara(opt);
          end;
@@ -96,36 +59,44 @@ begin
             'G' : initswitches:=initswitches-[cs_littlesize];
             'x' : initswitches:=initswitches+[cs_optimize,cs_maxoptimieren];
             'z' : initswitches:=initswitches+[cs_optimize,cs_uncertainopts];
-            '2' : opt_processors:=pentium2;
-            '3' : opt_processors:=globals.i386;
-            '4' : opt_processors:=i486;
-            '5' : opt_processors:=pentium;
-            '6' : opt_processors:=pentiumpro;
-            '7' : opt_processors:=cx6x86;
-            '8' : opt_processors:=amdk6
+            '2' : initoptprocessor:=pentium2;
+            '3' : initoptprocessor:=globals.i386;
+            '4' : initoptprocessor:=i486;
+            '5' : initoptprocessor:=pentium;
+            '6' : initoptprocessor:=pentiumpro;
+            '7' : initoptprocessor:=cx6x86;
+            '8' : initoptprocessor:=amdk6
             else IllegalPara(opt);
             end;
           end;
     'R' : begin
-            if copy(opt,3,length(opt)-2)='att' then
+            if More='ATT' then
              aktasmmode:=I386_ATT
             else
-             if copy(opt,3,length(opt)-2)='intel' then
+             if More='INTEL' then
               aktasmmode:=I386_INTEL
             else
-             if copy(opt,3,length(opt)-2)='direct' then
+             if More='DIRECT' then
               aktasmmode:=I386_DIRECT
             else
              IllegalPara(opt);
           end;
-  else IllegalPara(opt);
+  else
+   IllegalPara(opt);
   end;
 end;
 
 end.
 {
   $Log$
-  Revision 1.4  1998-05-10 12:07:15  jonas
+  Revision 1.5  1998-05-23 01:21:14  peter
+    + aktasmmode, aktoptprocessor, aktoutputformat
+    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
+    + $LIBNAME to set the library name where the unit will be put in
+    * splitted cgi386 a bit (codeseg to large for bp7)
+    * nasm, tasm works again. nasm moved to ag386nsm.pas
+
+  Revision 1.4  1998/05/10 12:07:15  jonas
     + switches for 6x86 and k6 optimizations
 
   Revision 1.3  1998/04/29 10:33:55  pierre

compiler/parser.pas

@@ -134,18 +134,19 @@ unit parser;
          olds_point,oldparse_only : boolean;
          oldc : char;
          oldcomment_level : word;
+         oldnextlabelnr : longint;
+         oldmacros,oldrefsymtable,oldsymtablestack : psymtable;
 
          oldimports,oldexports,oldresource,oldrttilist,
          oldbsssegment,olddatasegment,oldcodesegment,
          oldexprasmlist,olddebuglist,
          oldinternals,oldexternals,oldconsts : paasmoutput;
 
-
-         oldnextlabelnr : longint;
-
-         oldswitches : Tcswitches;
-         oldmacros,oldrefsymtable,oldsymtablestack : psymtable;
-
+         oldswitches     : tcswitches;
+         oldpackrecords  : word;
+         oldoutputformat : tasm;
+         oldoptprocessor : tprocessors;
+         oldasmmode      : tasmmode;
 
       procedure def_macro(const s : string);
 
@@ -193,7 +194,7 @@ unit parser;
            hp : pstring_item;
 
         begin
-           hp:=pstring_item(commandlinedefines.first);
+           hp:=pstring_item(initdefines.first);
            while assigned(hp) do
              begin
                def_macro(hp^.str^);
@@ -246,6 +247,7 @@ unit parser;
          oldc:=c;
          oldcomment_level:=comment_level;
 
+         oldnextlabelnr:=nextlabelnr;
          oldparse_only:=parse_only;
 
          { save assembler lists }
@@ -262,23 +264,30 @@ unit parser;
          oldexports:=exportssection;
          oldresource:=resourcesection;
 
+         { save the current state }
          oldswitches:=aktswitches;
-         oldnextlabelnr:=nextlabelnr;
+         oldpackrecords:=aktpackrecords;
+         oldoutputformat:=aktoutputformat;
+         oldoptprocessor:=aktoptprocessor;
+         oldasmmode:=aktasmmode;
 
          Message1(parser_i_compiling,filename);
 
          InitScanner(filename);
 
+       { Load current state from the init values }
          aktswitches:=initswitches;
+         aktpackrecords:=initpackrecords;
+         aktoutputformat:=initoutputformat;
+         aktoptprocessor:=initoptprocessor;
+         aktasmmode:=initasmmode;
 
          { we need this to make the system unit }
          if compile_system then
           aktswitches:=aktswitches+[cs_compilesystem];
 
-         aktpackrecords:=initpackrecords;
 
-         { init code generator for a new module }
-         codegen_newmodule;
+         { macros }
          macros:=new(psymtable,init(macrosymtable));
          macros^.name:=stringdup('Conditionals for '+filename);
          define_macros;
@@ -286,22 +295,13 @@ unit parser;
          { startup scanner }
          token:=yylex;
 
+         { init code generator for a new module }
+         codegen_newmodule;
          reset_gdb_info;
-         { init asm writing }
-         datasegment:=new(paasmoutput,init);
-         codesegment:=new(paasmoutput,init);
-         bsssegment:=new(paasmoutput,init);
-         debuglist:=new(paasmoutput,init);
-         externals:=new(paasmoutput,init);
-         internals:=new(paasmoutput,init);
-         consts:=new(paasmoutput,init);
-         rttilist:=new(paasmoutput,init);
-         importssection:=nil;
-         exportssection:=nil;
-         resourcesection:=nil;
 
          { global switches are read, so further changes aren't allowed }
          current_module^.in_main:=true;
+
          { open assembler response }
          if (compile_level=1) then
           AsmRes.Init('ppas');
@@ -384,16 +384,16 @@ unit parser;
              proc_program(token=_LIBRARY);
            end;
 
-         if errorcount=0 then
+         if status.errorcount=0 then
            begin
              if current_module^.uses_imports then
               importlib^.generatelib;
 
              GenerateAsm(filename);
 
-             if smartlink then
+             if (cs_smartlink in aktswitches) then
               begin
-                Linker.SetLibName(FileName);
+                Linker.SetLibName(current_module^.libfilename^);
                 Linker.MakeStaticLibrary(SmartLinkPath(FileName),SmartLinkFilesCnt);
               end;
 
@@ -413,9 +413,7 @@ unit parser;
                end;
            end
          else
-           Message1(unit_f_errors_in_unit,tostr(errorcount));
-        
-
+           Message1(unit_f_errors_in_unit,tostr(status.errorcount));
 done:
          { clear memory }
 {$ifdef Splitheap}
@@ -465,19 +463,19 @@ done:
          dispose(macros,done);
          macros:=oldmacros;
 
-
+         { restore scanner }
          preprocstack:=oldpreprocstack;
-
-         aktswitches:=oldswitches;
          inputbuffer:=oldinputbuffer;
          inputpointer:=oldinputpointer;
          s_point:=olds_point;
          c:=oldc;
          comment_level:=oldcomment_level;
 
+         nextlabelnr:=oldnextlabelnr;
          parse_only:=oldparse_only;
 
          { restore asmlists }
+         exprasmlist:=oldexprasmlist;
          datasegment:=olddatasegment;
          bsssegment:=oldbsssegment;
          codesegment:=oldcodesegment;
@@ -489,8 +487,12 @@ done:
          exportssection:=oldexports;
          resourcesection:=oldresource;
 
-         nextlabelnr:=oldnextlabelnr;
-         exprasmlist:=oldexprasmlist;
+         { restore current state }
+         aktswitches:=oldswitches;
+         aktpackrecords:=oldpackrecords;
+         aktoutputformat:=oldoutputformat;
+         aktoptprocessor:=oldoptprocessor;
+         aktasmmode:=oldasmmode;
 
          if (compile_level=1) then
           begin
@@ -506,7 +508,14 @@ done:
 end.
 {
   $Log$
-  Revision 1.17  1998-05-20 09:42:34  pierre
+  Revision 1.18  1998-05-23 01:21:15  peter
+    + aktasmmode, aktoptprocessor, aktoutputformat
+    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
+    + $LIBNAME to set the library name where the unit will be put in
+    * splitted cgi386 a bit (codeseg to large for bp7)
+    * nasm, tasm works again. nasm moved to ag386nsm.pas
+
+  Revision 1.17  1998/05/20 09:42:34  pierre
     + UseTokenInfo now default
     * unit in interface uses and implementation uses gives error now
     * only one error for unknown symbol (uses lastsymknown boolean)

compiler/pass_1.pas

@@ -63,9 +63,9 @@ unit pass_1;
       begin
          if not(codegenerror) then
            begin
-              olderrorcount:=errorcount;
+              olderrorcount:=status.errorcount;
               verbose.Message(t);
-              codegenerror:=olderrorcount<>errorcount;
+              codegenerror:=olderrorcount<>status.errorcount;
            end;
       end;
 
@@ -77,9 +77,9 @@ unit pass_1;
       begin
          if not(codegenerror) then
            begin
-              olderrorcount:=errorcount;
+              olderrorcount:=status.errorcount;
               verbose.Message1(t,s);
-              codegenerror:=olderrorcount<>errorcount;
+              codegenerror:=olderrorcount<>status.errorcount;
            end;
       end;
 
@@ -91,9 +91,9 @@ unit pass_1;
       begin
          if not(codegenerror) then
            begin
-              olderrorcount:=errorcount;
+              olderrorcount:=status.errorcount;
               verbose.Message2(t,s1,s2);
-              codegenerror:=olderrorcount<>errorcount;
+              codegenerror:=olderrorcount<>status.errorcount;
            end;
       end;
 
@@ -105,9 +105,9 @@ unit pass_1;
       begin
          if not(codegenerror) then
            begin
-              olderrorcount:=errorcount;
+              olderrorcount:=status.errorcount;
               verbose.Message3(t,s1,s2,s3);
-              codegenerror:=olderrorcount<>errorcount;
+              codegenerror:=olderrorcount<>status.errorcount;
            end;
       end;
 
@@ -1473,7 +1473,7 @@ unit pass_1;
            { nasm can not cope with negativ reals !! }
          if is_constrealnode(p^.left)
 {$ifdef i386}
-         and not(current_module^.output_format in [of_nasm,of_obj])
+         and not(aktoutputformat in [as_nasmcoff,as_nasmelf,as_nasmobj])
 {$endif}
            then
            begin
@@ -4894,7 +4894,14 @@ unit pass_1;
 end.
 {
   $Log$
-  Revision 1.19  1998-05-20 09:42:34  pierre
+  Revision 1.20  1998-05-23 01:21:17  peter
+    + aktasmmode, aktoptprocessor, aktoutputformat
+    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
+    + $LIBNAME to set the library name where the unit will be put in
+    * splitted cgi386 a bit (codeseg to large for bp7)
+    * nasm, tasm works again. nasm moved to ag386nsm.pas
+
+  Revision 1.19  1998/05/20 09:42:34  pierre
     + UseTokenInfo now default
     * unit in interface uses and implementation uses gives error now
     * only one error for unknown symbol (uses lastsymknown boolean)

compiler/pbase.pas

@@ -211,7 +211,7 @@ unit pbase;
               if (st^.symtabletype=objectsymtable) and
                  ((current_object_option and sp_static)<>0) then
                 begin
-                   s:=lowercase(st^.name^)+'_'+s;
+                   s:=lower(st^.name^)+'_'+s;
                    st^.defowner^.owner^.insert(new(pvarsym,init(s,def)));
                 end;
               s:=sc^.get_with_tokeninfo(filepos);
@@ -223,7 +223,14 @@ end.
 
 {
   $Log$
-  Revision 1.7  1998-05-20 09:42:35  pierre
+  Revision 1.8  1998-05-23 01:21:18  peter
+    + aktasmmode, aktoptprocessor, aktoutputformat
+    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
+    + $LIBNAME to set the library name where the unit will be put in
+    * splitted cgi386 a bit (codeseg to large for bp7)
+    * nasm, tasm works again. nasm moved to ag386nsm.pas
+
+  Revision 1.7  1998/05/20 09:42:35  pierre
     + UseTokenInfo now default
     * unit in interface uses and implementation uses gives error now
     * only one error for unknown symbol (uses lastsymknown boolean)

compiler/pdecl.pas

@@ -995,7 +995,7 @@ unit pdecl;
          testcurobject:=0;
          curobjectname:='';
 
-         if smartlink then
+         if (cs_smartlink in aktswitches) then
            datasegment^.concat(new(pai_cut,init));
 {$ifdef GDB}
          { generate the VMT }
@@ -1773,7 +1773,14 @@ unit pdecl;
 end.
 {
   $Log$
-  Revision 1.18  1998-05-20 09:42:35  pierre
+  Revision 1.19  1998-05-23 01:21:19  peter
+    + aktasmmode, aktoptprocessor, aktoutputformat
+    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
+    + $LIBNAME to set the library name where the unit will be put in
+    * splitted cgi386 a bit (codeseg to large for bp7)
+    * nasm, tasm works again. nasm moved to ag386nsm.pas
+
+  Revision 1.18  1998/05/20 09:42:35  pierre
     + UseTokenInfo now default
     * unit in interface uses and implementation uses gives error now
     * only one error for unknown symbol (uses lastsymknown boolean)

compiler/pexpr.pas

@@ -620,7 +620,7 @@ unit pexpr;
                         Message(parser_e_only_class_methods_via_class_ref);
                       if (sym^.properties and sp_static)<>0 then
                         begin
-                           static_name:=lowercase(srsymtable^.name^)+'_'+sym^.name;
+                           static_name:=lower(srsymtable^.name^)+'_'+sym^.name;
                            getsym(static_name,true);
                            disposetree(p1);
                            p1:=genloadnode(pvarsym(srsym),srsymtable);
@@ -1016,7 +1016,7 @@ unit pexpr;
 
                                        if (srsym^.properties and sp_static)<>0 then
                                          begin
-                                            static_name:=lowercase(srsymtable^.name^)+'_'+srsym^.name;
+                                            static_name:=lower(srsymtable^.name^)+'_'+srsym^.name;
                                             getsym(static_name,true);
                                          end;
                                        p1:=genloadnode(pvarsym(srsym),srsymtable);
@@ -1733,7 +1733,14 @@ unit pexpr;
 end.
 {
   $Log$
-  Revision 1.17  1998-05-22 12:37:03  carl
+  Revision 1.18  1998-05-23 01:21:20  peter
+    + aktasmmode, aktoptprocessor, aktoutputformat
+    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
+    + $LIBNAME to set the library name where the unit will be put in
+    * splitted cgi386 a bit (codeseg to large for bp7)
+    * nasm, tasm works again. nasm moved to ag386nsm.pas
+
+  Revision 1.17  1998/05/22 12:37:03  carl
     * crash bugfix (patched msanually to main branch)
 
   Revision 1.16  1998/05/21 19:33:32  peter

compiler/pmodules.pas

@@ -80,34 +80,34 @@ unit pmodules;
     procedure insertsegment;
       begin
       {Insert Ident of the compiler}
-        if (not smartlink)
-{$ifndef EXTDEBUG}      
+        if (not (cs_smartlink in aktswitches))
+{$ifndef EXTDEBUG}
            and (not current_module^.is_unit)
-{$endif}        
-
+{$endif}
            then
          begin
            datasegment^.insert(new(pai_align,init(4)));
            datasegment^.insert(new(pai_string,init('FPC '+version_string+' for '+target_string+' - '+target_info.short_name)));
          end;
-
+      { Insert start and end of sections }
         codesegment^.insert(new(pai_section,init(sec_code)));
+        codesegment^.concat(new(pai_section,init(sec_none)));
         datasegment^.insert(new(pai_section,init(sec_data)));
+        datasegment^.concat(new(pai_section,init(sec_none)));
         bsssegment^.insert(new(pai_section,init(sec_bss)));
-        consts^.insert(new(pai_section,init(sec_data)));
+        bsssegment^.concat(new(pai_section,init(sec_none)));
         consts^.insert(new(pai_asm_comment,init('Constants')));
+        consts^.insert(new(pai_section,init(sec_data)));
+        consts^.concat(new(pai_section,init(sec_none)));
       end;
 
     procedure insertheap;
       begin
-         if smartlink then
+         if (cs_smartlink in aktswitches) then
            begin
              bsssegment^.concat(new(pai_cut,init));
              datasegment^.concat(new(pai_cut,init));
            end;
-
-
-
         { On the Macintosh Classic M68k Architecture
           The Heap variable is simply a POINTER to the
           real HEAP. The HEAP must be set up by the RTL
@@ -129,7 +129,6 @@ unit pmodules;
       var
         i : longint;
       begin
-
         case target_info.target of
        target_GO32V2 : begin
                        { stacksize can be specified }
@@ -147,16 +146,11 @@ unit pmodules;
                            importssection^.concat(new(pai_const,init_32bit(0)));
                        end;
         end;
-
       end;
 
 
-
-
     { all intern procedures for system unit }
-
     procedure insertinternsyms(p : psymtable);
-
       begin
          p^.insert(new(psyssym,init('CONCAT',in_concat_x)));
          p^.insert(new(psyssym,init('WRITE',in_write_x)));
@@ -177,7 +171,6 @@ unit pmodules;
          p^.insert(new(psyssym,init('INCLUDE',in_include_x_y)));
          p^.insert(new(psyssym,init('BREAK',in_break)));
          p^.insert(new(psyssym,init('CONTINUE',in_continue)));
-
          { for testing purpose }
          p^.insert(new(psyssym,init('DECI',in_dec_x)));
          p^.insert(new(psyssym,init('INCI',in_inc_x)));
@@ -194,7 +187,6 @@ unit pmodules;
          vmtarraydef : parraydef;
          vmtsymtable : psymtable;
 {$endif GDB}
-
       begin
          p^.insert(new(ptypesym,init('longint',s32bitdef)));
          p^.insert(new(ptypesym,init('ulong',u32bitdef)));
@@ -274,8 +266,8 @@ unit pmodules;
          insertinternsyms(p);
       end;
 
-    procedure load_ppu(oldhp,hp : pmodule;compile_system : boolean);
 
+    procedure load_ppu(oldhp,hp : pmodule;compile_system : boolean);
       var
          loaded_unit  : pmodule;
          b            : byte;
@@ -283,8 +275,6 @@ unit pmodules;
 {$ifndef NEWPPU}
          count,
 {$endif NEWPPU}
-
-
          nextmapentry : longint;
          hs           : string;
       begin
@@ -301,11 +291,9 @@ unit pmodules;
              begin
                hs:=hp^.ppufile^.getstring;
                checksum:=hp^.ppufile^.getlongint;
-
                loaded_unit:=loadunit(hs,false,false);
                if hp^.compiled then
                 exit;
-
              { if the crc of a used unit is the same as written to the
                PPU file, we needn't to recompile the current unit }
                if (loaded_unit^.crc<>checksum) then
@@ -335,7 +323,6 @@ unit pmodules;
                    end;
                   exit;
                 end;
-
              { setup the map entry for deref }
                hp^.map^[nextmapentry]:=loaded_unit^.symtable;
                inc(nextmapentry);
@@ -344,17 +331,14 @@ unit pmodules;
              end;
           { ok, now load the unit }
             hp^.symtable:=new(punitsymtable,load(hp^.unitname^));
-
           { if this is the system unit insert the intern symbols }
             make_ref:=false;
             if compile_system then
               insertinternsyms(psymtable(hp^.symtable));
             make_ref:=true;
           end;
-
        { now only read the implementation part }
          hp^.in_implementation:=true;
-
        { load the used units from implementation }
          b:=hp^.ppufile^.readentry;
          if b=ibloadunit_imp then
@@ -363,7 +347,6 @@ unit pmodules;
              begin
                hs:=hp^.ppufile^.getstring;
                checksum:=hp^.ppufile^.getlongint;
-
                loaded_unit:=loadunit(hs,false,false);
                if hp^.compiled then
                 exit;
@@ -371,9 +354,7 @@ unit pmodules;
           end;
          hp^.ppufile^.close;
 {!         dispose(hp^.ppufile,done);}
-
 {$else}
-
          { load the used units from interface }
          hp^.ppufile^.read_data(b,1,count);
          while (b=ibloadunit) do
@@ -399,7 +380,7 @@ unit pmodules;
                    dispose(hp^.ppufile,done);
                    hp^.ppufile:=nil;
                    if not(hp^.sources_avail) then
-                    Message1(unit_f_cant_compile_unit,hp^.unitname^)
+                    Message1(unit_f_cant_compile_unit,hp^.modulename^)
                    else
                     begin
 {$ifdef TEST_TEMPCLOSE}
@@ -417,26 +398,21 @@ unit pmodules;
               { setup the map entry for deref }
               hp^.map^[nextmapentry]:=loaded_unit^.symtable;
               inc(nextmapentry);
-
               if nextmapentry>maxunits then
                Message(unit_f_too_much_units);
-
               { read until ibend }
               hp^.ppufile^.read_data(b,1,count);
            end;
          { ok, now load the unit }
-         hp^.symtable:=new(punitsymtable,load(hp^.unitname^));
-
+         hp^.symtable:=new(punitsymtable,load(hp^.modulename^));
          { if this is the system unit insert the intern }
          { symbols                                      }
          make_ref:=false;
          if compile_system then
            insertinternsyms(psymtable(hp^.symtable));
          make_ref:=true;
-
          { now only read the implementation part }
          hp^.in_implementation:=true;
-
          { load the used units from implementation }
          hp^.ppufile^.read_data(b,1,count);
          while (b<>ibend) and (b=ibloadunit) do
@@ -489,7 +465,6 @@ unit pmodules;
 
 
     function loadunit(const s : string;compile_system, in_uses : boolean) : pmodule;
-
       var
          st : punitsymtable;
          old_current_module,hp,nextmodule : pmodule;
@@ -505,7 +480,7 @@ unit pmodules;
          hp:=pmodule(loaded_units.first);
          while assigned(hp) do
            begin
-              if hp^.unitname^=s then
+              if hp^.modulename^=s then
                 begin
                    { the unit is already registered   }
                    { and this means that the unit     }
@@ -524,7 +499,6 @@ unit pmodules;
               { the next unit }
               hp:=pmodule(hp^.next);
            end;
-
        { no error and the unit isn't loaded }
          if not(assigned(hp)) and (st=nil) then
            begin
@@ -532,7 +506,6 @@ unit pmodules;
               hp:=new(pmodule,init(s,true));
               { now we can register the unit }
               loaded_units.insert(hp);
-
               current_module:=hp;
               { force build ? }
               if (hp^.do_compile) or (hp^.sources_avail and do_build) then
@@ -544,7 +517,7 @@ unit pmodules;
                         hp^.ppufile:=nil;
                      end;
                    if not(hp^.sources_avail) then
-                    Message1(unit_f_cant_compile_unit,hp^.unitname^)
+                    Message1(unit_f_cant_compile_unit,hp^.modulename^)
                    else
                     begin
 {$ifdef TEST_TEMPCLOSE}
@@ -574,7 +547,6 @@ unit pmodules;
                  { add the files for the linker }
                   addlinkerfiles(hp);
                 end;
-
               { register the unit _once_ }
               usedunits.concat(new(pused_unit,init(hp,0)));
               { the unit is written, so we can set the symtable type }
@@ -640,15 +612,14 @@ unit pmodules;
          loadunit:=hp;
       end;
 
-    procedure loadunits;
 
+    procedure loadunits;
       var
          s : stringid;
          hp : pused_unit;
          hp2 : pmodule;
          hp3 : psymtable;
          oldprocsym:Pprocsym;
-
       begin
          oldprocsym:=aktprocsym;
          consume(_USES);
@@ -752,7 +723,8 @@ unit pmodules;
           begin
           { create filenames and unit name }
              current_module^.SetFileName(current_module^.current_inputfile^.path^,current_module^.current_inputfile^.name^);
-             current_module^.unitname:=stringdup(upper(pattern));
+             stringdispose(current_module^.modulename);
+             current_module^.modulename:=stringdup(upper(pattern));
 
           { check for system unit }
              new(s1);
@@ -762,20 +734,20 @@ unit pmodules;
              if (cs_compilesystem in aktswitches)  then
               begin
                 if (cs_check_unit_name in aktswitches) and
-                   ((length(current_module^.unitname^)>8) or
-                    (current_module^.unitname^<>s1^) or
-                    (current_module^.unitname^<>s2^)) then
+                   ((length(current_module^.modulename^)>8) or
+                    (current_module^.modulename^<>s1^) or
+                    (current_module^.modulename^<>s2^)) then
                   Message1(unit_e_illegal_unit_name,s1^);
               end
              else
-              if (current_module^.unitname^=s1^) then
+              if (current_module^.modulename^=s1^) then
                Message(unit_w_switch_us_missed);
              dispose(s2);
              dispose(s1);
 
           { Add Object File }
-             if smartlink then
-              current_module^.linkstaticlibs.insert(current_module^.arfilename^)
+             if (cs_smartlink in aktswitches) then
+              current_module^.linkstaticlibs.insert(current_module^.libfilename^)
              else
               current_module^.linkofiles.insert(current_module^.objfilename^);
           end;
@@ -786,7 +758,7 @@ unit pmodules;
 
          { this should be placed after uses !!}
 {$ifndef UseNiceNames}
-         procprefix:='_'+current_module^.unitname^+'$$';
+         procprefix:='_'+current_module^.modulename^+'$$';
 {$else UseNiceNames}
          procprefix:='_'+tostr(length(current_module^.unitname^))+lowercase(current_module^.unitname^)+'_';
 {$endif UseNiceNames}
@@ -794,7 +766,7 @@ unit pmodules;
          parse_only:=true;
 
          { generate now the global symboltable }
-         p:=new(punitsymtable,init(globalsymtable,current_module^.unitname^));
+         p:=new(punitsymtable,init(globalsymtable,current_module^.modulename^));
          refsymtable:=p;
          unitst:=punitsymtable(p);
 
@@ -802,7 +774,7 @@ unit pmodules;
          { inside the unit itself (PM)                      }
          { this also forbids to have another symbol         }
          { with the same name as the unit                   }
-         refsymtable^.insert(new(punitsym,init(current_module^.unitname^,unitst)));
+         refsymtable^.insert(new(punitsym,init(current_module^.modulename^,unitst)));
          { set the symbol table for the current unit }
          { this must be set later for interdependency }
          { current_module^.symtable:=psymtable(p); }
@@ -895,15 +867,15 @@ unit pmodules;
          only_calculate_crc:=false;
          }
          { generates static symbol table }
-         p:=new(punitsymtable,init(staticsymtable,current_module^.unitname^));
+         p:=new(punitsymtable,init(staticsymtable,current_module^.modulename^));
          { must be done only after _USES !! (PM)
          refsymtable:=p;}
 
          {Generate a procsym.}
-         aktprocsym:=new(Pprocsym,init(current_module^.unitname^+'_init'));
+         aktprocsym:=new(Pprocsym,init(current_module^.modulename^+'_init'));
          aktprocsym^.definition:=new(Pprocdef,init);
          aktprocsym^.definition^.options:=aktprocsym^.definition^.options or pounitinit;
-         aktprocsym^.definition^.setmangledname(current_module^.unitname^+'_init');
+         aktprocsym^.definition^.setmangledname(current_module^.modulename^+'_init');
 
          {The generated procsym has a local symtable. Discard it and turn
           it into the static one.}
@@ -956,8 +928,8 @@ unit pmodules;
          codegen_newprocedure;
 
          names.init;
-         names.insert(current_module^.unitname^+'_init');
-         names.insert('INIT$$'+current_module^.unitname^);
+         names.insert(current_module^.modulename^+'_init');
+         names.insert('INIT$$'+current_module^.modulename^);
          compile_proc_body(names,true,false);
          names.done;
 
@@ -994,7 +966,7 @@ unit pmodules;
          punitsymtable(symtablestack)^.is_stab_written:=false;
 
          {Write out the unit if the compile was succesfull.}
-         if errorcount=0 then
+         if status.errorcount=0 then
           writeunitas(current_module^.ppufilename^,punitsymtable(symtablestack));
 
          pu:=pused_unit(usedunits.first);
@@ -1013,9 +985,8 @@ unit pmodules;
     procedure proc_program(islibrary : boolean);
 
       var
-         st : psymtable;
-         programname : stringid;
-         names:Tstringcontainer;
+         st    : psymtable;
+         names : Tstringcontainer;
       begin
          { Trying to compile the system unit... }
          { if no unit defined... then issue a   }
@@ -1032,12 +1003,11 @@ unit pmodules;
          end;}
 
          parse_only:=false;
-         programname:='';
-
          if islibrary then
            begin
               consume(_LIBRARY);
-              programname:=pattern;
+              stringdispose(current_module^.modulename);
+              current_module^.modulename:=stringdup(pattern);
               consume(ID);
               consume(SEMICOLON);
            end
@@ -1046,7 +1016,8 @@ unit pmodules;
            if token=_PROGRAM then
             begin
               consume(_PROGRAM);
-              programname:=pattern;
+              stringdispose(current_module^.modulename);
+              current_module^.modulename:=stringdup(pattern);
               consume(ID);
               if token=LKLAMMER then
                 begin
@@ -1059,7 +1030,7 @@ unit pmodules;
 
          { insert after the unit symbol tables the static symbol table }
          { of the program                                              }
-         st:=new(punitsymtable,init(staticsymtable,programname));
+         st:=new(punitsymtable,init(staticsymtable,current_module^.modulename^));
 
          {Generate a procsym.}
          aktprocsym:=new(Pprocsym,init('main'));
@@ -1087,24 +1058,22 @@ unit pmodules;
            loadunits;
 
          {Insert the name of the main program into the symbol table.}
-         if programname<>'' then
-           st^.insert(new(pprogramsym,init(programname)));
+         if current_module^.modulename^<>'' then
+           st^.insert(new(pprogramsym,init(current_module^.modulename^)));
 
          { ...is also constsymtable, this is the symtable where }
          { the elements of enumeration types are inserted       }
          constsymtable:=st;
 
          { set some informations about the main program }
-         procinfo.retdef:=voiddef;
-         procinfo._class:=nil;
-         procinfo.call_offset:=8;
-
-         {Set the framepointer of the program initialization to the
-          default framepointer (EBP on i386).}
-         procinfo.framepointer:=frame_pointer;
-
-         { clear flags }
-         procinfo.flags:=0;
+         with procinfo do
+          begin
+            retdef:=voiddef;
+            _class:=nil;
+            call_offset:=8;
+            framepointer:=frame_pointer;
+            flags:=0;
+          end;
 
          procprefix:='';
          in_except_block:=false;
@@ -1124,22 +1093,16 @@ unit pmodules;
 
          consume(POINT);
 
-
-
-         if smartlink then
-          current_module^.linkstaticlibs.insert(current_module^.arfilename^)
+         if (cs_smartlink in aktswitches) then
+          current_module^.linkstaticlibs.insert(current_module^.libfilename^)
          else
           current_module^.linkofiles.insert(current_module^.objfilename^);
 
          insertheap;
          inserttargetspecific;
 
-
-
          datasize:=symtablestack^.datasize;
-         { symtablestack^.check_forwards;
-         symtablestack^.allsymbolsused;
-         done in compile_proc_body }
+
          { finish asmlist by adding segment starts }
          insertsegment;
       end;
@@ -1147,7 +1110,14 @@ unit pmodules;
 end.
 {
   $Log$
-  Revision 1.14  1998-05-20 09:42:35  pierre
+  Revision 1.15  1998-05-23 01:21:22  peter
+    + aktasmmode, aktoptprocessor, aktoutputformat
+    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
+    + $LIBNAME to set the library name where the unit will be put in
+    * splitted cgi386 a bit (codeseg to large for bp7)
+    * nasm, tasm works again. nasm moved to ag386nsm.pas
+
+  Revision 1.14  1998/05/20 09:42:35  pierre
     + UseTokenInfo now default
     * unit in interface uses and implementation uses gives error now
     * only one error for unknown symbol (uses lastsymknown boolean)

compiler/pp.pas

@@ -341,10 +341,10 @@ begin
 
    start:=getrealtime;
    compile(inputdir+inputfile+inputextension,false);
-   if errorcount=0 then
+   if status.errorcount=0 then
     begin
       start:=getrealtime-start;
-      Message2(general_i_abslines_compiled,tostr(abslines),tostr(trunc(start))+'.'+tostr(trunc(frac(start)*10)));
+      Message2(general_i_abslines_compiled,tostr(status.compiledlines),tostr(trunc(start))+'.'+tostr(trunc(frac(start)*10)));
     end;
 
    clearnodes;
@@ -353,14 +353,21 @@ begin
    Comment(V_Info,'Memory lost = '+tostr(EntryMemAvail-MemAvail));
 {$endif EXTDEBUG}
 { exits with error 1 if no codegeneration }
-   if errorcount=0 then
+   if status.errorcount=0 then
     halt(0)
    else
     halt(1);
 end.
 {
   $Log$
-  Revision 1.11  1998-05-20 09:42:35  pierre
+  Revision 1.12  1998-05-23 01:21:23  peter
+    + aktasmmode, aktoptprocessor, aktoutputformat
+    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
+    + $LIBNAME to set the library name where the unit will be put in
+    * splitted cgi386 a bit (codeseg to large for bp7)
+    * nasm, tasm works again. nasm moved to ag386nsm.pas
+
+  Revision 1.11  1998/05/20 09:42:35  pierre
     + UseTokenInfo now default
     * unit in interface uses and implementation uses gives error now
     * only one error for unknown symbol (uses lastsymknown boolean)

compiler/rai386.pas

@@ -1345,7 +1345,7 @@ var
     { this makes cpu.pp uncompilable, but i think this code should be }
     { inserted in the system unit anyways.                            }
     if (instruc >= lastop_in_table) and
-       ((cs_compilesystem in aktswitches) or (opt_processors > globals.i386)) then
+       ((cs_compilesystem in aktswitches) or (aktoptprocessor > globals.i386)) then
       begin
          Message(assem_w_opcode_not_in_table);
          fits:=true;
@@ -3369,7 +3369,14 @@ Begin
 end.
 {
   $Log$
-  Revision 1.5  1998-05-20 09:42:36  pierre
+  Revision 1.6  1998-05-23 01:21:26  peter
+    + aktasmmode, aktoptprocessor, aktoutputformat
+    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
+    + $LIBNAME to set the library name where the unit will be put in
+    * splitted cgi386 a bit (codeseg to large for bp7)
+    * nasm, tasm works again. nasm moved to ag386nsm.pas
+
+  Revision 1.5  1998/05/20 09:42:36  pierre
     + UseTokenInfo now default
     * unit in interface uses and implementation uses gives error now
     * only one error for unknown symbol (uses lastsymknown boolean)

compiler/ratti386.pas

@@ -1536,7 +1536,7 @@ const
     { the att version only if the processor > i386 or we are compiling  }
     { the system unit then this will be allowed...                      }
     if (instruc >= lastop_in_table) and
-       ((cs_compilesystem in aktswitches) or (opt_processors > globals.i386)) then
+       ((cs_compilesystem in aktswitches) or (aktoptprocessor > globals.i386)) then
       begin
          Message1(assem_w_opcode_not_in_table,att_op2str[instruc]);
          fits:=true;
@@ -3681,7 +3681,14 @@ end.
 
 {
   $Log$
-  Revision 1.6  1998-05-20 09:42:37  pierre
+  Revision 1.7  1998-05-23 01:21:27  peter
+    + aktasmmode, aktoptprocessor, aktoutputformat
+    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
+    + $LIBNAME to set the library name where the unit will be put in
+    * splitted cgi386 a bit (codeseg to large for bp7)
+    * nasm, tasm works again. nasm moved to ag386nsm.pas
+
+  Revision 1.6  1998/05/20 09:42:37  pierre
     + UseTokenInfo now default
     * unit in interface uses and implementation uses gives error now
     * only one error for unknown symbol (uses lastsymknown boolean)

compiler/scandir.inc

@@ -32,12 +32,12 @@ type
      _DIR_FATAL,
      _DIR_I,_DIR_I386_ATT,_DIR_I386_DIRECT,_DIR_I386_INTEL,_DIR_IOCHECKS,
        _DIR_IF,_DIR_IFDEF,_DIR_IFNDEF,_DIR_IFOPT,_DIR_INFO,
-     _DIR_L,_DIR_LINKLIB,
+     _DIR_L,_DIR_LIBNAME,_DIR_LINKLIB,
      _DIR_MESSAGE,_DIR_MMX,
      _DIR_NOTE,
      _DIR_OUTPUT_FORMAT,
      _DIR_PACKRECORDS,
-     _DIR_SATURATION,_DIR_STOP,
+     _DIR_SATURATION,_DIR_SMARTLINK,_DIR_STOP,
      _DIR_UNDEF,
      _DIR_WAIT,_DIR_WARNING
      );
@@ -52,12 +52,12 @@ const
      'FATAL',
      'I','I386_ATT','I386_DIRECT','I386_INTEL','IOCHECKS',
        'IF','IFDEF','IFNDEF','IFOPT','INFO',
-     'L','LINKLIB',
+     'L','LIBNAME','LINKLIB',
      'MESSAGE','MMX',
      'NOTE',
      'OUTPUT_FORMAT',
      'PACKRECORDS',
-     'SATURATION','STOP',
+     'SATURATION','SMARTLINK','STOP',
      'UNDEF',
      'WAIT','WARNING'
      );
@@ -566,17 +566,21 @@ const
 
 
     procedure dir_switch(t:tdirectivetoken);
-{$ifdef SUPPORT_MMX}
       var
         sw : tcswitch;
-{$endif}
       begin
-{$ifdef SUPPORT_MMX}
         case t of
+{$ifdef SUPPORT_MMX}
           _DIR_MMX : sw:=cs_mmx;
    _DIR_SATURATION : sw:=cs_mmx_saturation;
-        end;
 {$endif}
+   _DIR_SMARTLINK : sw:=cs_smartlink;
+        end;
+        skipspace;
+        if c='-' then
+         aktswitches:=aktswitches-[sw]
+        else
+         aktswitches:=aktswitches+[sw];
       end;
 
 
@@ -635,6 +639,14 @@ const
       end;
 
 
+    procedure dir_libname(t:tdirectivetoken);
+      begin
+        skipspace;
+        stringdispose(current_module^.libfilename);
+        current_module^.libfilename:=stringdup(readstring);
+      end;
+
+
     procedure dir_outputformat(t:tdirectivetoken);
       var
         hs : string;
@@ -645,26 +657,14 @@ const
           begin
             skipspace;
             hs:=readid;
-{$ifdef i386}
-            if hs='NASM' then
-              current_module^.output_format:=of_nasm
-            else
-             if hs='MASM' then
-              current_module^.output_format:=of_masm
+            if set_string_asm(hs) then
+             aktoutputformat:=target_asm.id
             else
-             if hs='O' then
-              current_module^.output_format:=of_o
-            else
-             if hs='OBJ' then
-              current_module^.output_format:=of_obj
-            else
-{$endif}
-              Message(scan_w_illegal_switch);
+             Message(scan_w_illegal_switch);
           end;
-      { for use in globals }
-        output_format:=current_module^.output_format;
       end;
 
+
     procedure dir_packrecords(t:tdirectivetoken);
       var
         hs : string;
@@ -748,6 +748,7 @@ const
          {_DIR_IFOPT} dir_conditional,
          {_DIR_INFO} dir_message,
          {_DIR_L} dir_linkobject,
+         {_DIR_LIBNAME} dir_libname,
          {_DIR_LINKLIB} dir_linklib,
          {_DIR_MESSAGE} dir_message,
          {_DIR_MMX} dir_switch,
@@ -755,6 +756,7 @@ const
          {_DIR_OUTPUT_FORMAT} dir_outputformat,
          {_DIR_PACKRECORDS} dir_packrecords,
          {_DIR_SATURATION} dir_switch,
+         {_DIR_SMARTLINK} dir_switch,
          {_DIR_STOP} dir_message,
          {_DIR_UNDEF} dir_undef,
          {_DIR_WAIT} dir_wait,
@@ -814,7 +816,14 @@ const
 
 {
   $Log$
-  Revision 1.8  1998-05-11 13:07:57  peter
+  Revision 1.9  1998-05-23 01:21:28  peter
+    + aktasmmode, aktoptprocessor, aktoutputformat
+    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
+    + $LIBNAME to set the library name where the unit will be put in
+    * splitted cgi386 a bit (codeseg to large for bp7)
+    * nasm, tasm works again. nasm moved to ag386nsm.pas
+
+  Revision 1.8  1998/05/11 13:07:57  peter
     + $ifdef NEWPPU for the new ppuformat
     + $define GDB not longer required
     * removed all warnings and stripped some log comments

compiler/scanner.pas

@@ -179,8 +179,9 @@ unit scanner;
   implementation
 
      uses
-       dos,verbose,pbase,
-       symtable,switches;
+       dos,verbose,systems,
+       pbase,symtable,
+       switches;
 
 {*****************************************************************************
                               TPreProcStack
@@ -375,17 +376,12 @@ unit scanner;
               inc(longint(inputpointer));
           end;
         c:=newline;
-      { Update Status and show status }
-        with status do
-         begin
-           totalcompiledlines:=abslines;
-           currentline:=current_module^.current_inputfile^.line_no;
-         end;
+      { show status }
         Comment(V_Status,'');
-
-      { increase line counters }        
+      { increase line counters }
         inc(current_module^.current_inputfile^.line_no);
-        inc(abslines);
+        status.currentline:=current_module^.current_inputfile^.line_no;
+        inc(status.compiledlines);
         lastlinepos:=longint(inputpointer);
       end;
 
@@ -841,7 +837,7 @@ unit scanner;
                       end;
                 '+' : begin
                         readchar;
-                        if (c='=') and c_like_operators then
+                        if (c='=') and support_c_operators then
                          begin
                            readchar;
                            yylex:=_PLUSASN;
@@ -852,7 +848,7 @@ unit scanner;
                       end;
                 '-' : begin
                         readchar;
-                        if (c='=') and c_like_operators then
+                        if (c='=') and support_c_operators then
                          begin
                            readchar;
                            yylex:=_MINUSASN;
@@ -874,7 +870,7 @@ unit scanner;
                       end;
                 '*' : begin
                         readchar;
-                        if (c='=') and c_like_operators then
+                        if (c='=') and support_c_operators then
                          begin
                            readchar;
                            yylex:=_STARASN;
@@ -891,7 +887,7 @@ unit scanner;
                         readchar;
                         case c of
                          '=' : begin
-                                 if c_like_operators then
+                                 if support_c_operators then
                                   begin
                                     readchar;
                                     yylex:=_SLASHASN;
@@ -1218,7 +1214,14 @@ unit scanner;
 end.
 {
   $Log$
-  Revision 1.19  1998-05-20 09:42:37  pierre
+  Revision 1.20  1998-05-23 01:21:30  peter
+    + aktasmmode, aktoptprocessor, aktoutputformat
+    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
+    + $LIBNAME to set the library name where the unit will be put in
+    * splitted cgi386 a bit (codeseg to large for bp7)
+    * nasm, tasm works again. nasm moved to ag386nsm.pas
+
+  Revision 1.19  1998/05/20 09:42:37  pierre
     + UseTokenInfo now default
     * unit in interface uses and implementation uses gives error now
     * only one error for unknown symbol (uses lastsymknown boolean)

compiler/systems.pas

@@ -32,22 +32,22 @@ unit systems;
        tos = (os_GO32V1, os_GO32V2, os_Linux, os_OS2,
               os_WIN32, os_Amiga, os_Atari, os_Mac68k);
 
-       tasm = (as_as
+       tasm = (as_o
        {$ifdef i386}
-              ,as_nasmcoff, as_nasmelf, as_nasmobj
+              ,as_nasmcoff, as_nasmelf, as_nasmobj, as_tasm, as_masm
        {$endif}
        {$ifdef m68k}
-              ,as_as68k
+              ,as_gas,as_mit,as_mot
        {$endif}
        );
 
        tlink = (link_ld
        {$ifdef i386}
-              ,link_ldgo32v1, link_ldgo32v2, link_ldw, link_ldos2);
+              ,link_ldgo32v1, link_ldgo32v2, link_ldw, link_ldos2
        {$endif i386}
        {$ifdef m68k}
-              );
        {$endif}
+       );
 
        tendian = (endian_little,en_big_endian);
 
@@ -70,6 +70,7 @@ unit systems;
           idtxt       : string[8];
           asmbin      : string[8];
           asmcmd      : string[50];
+          externals   : boolean;
           labelprefix : string[2];
           comment     : string[2];
        end;
@@ -102,6 +103,7 @@ unit systems;
           assem       : tasm;
        end;
 
+
     var
        target_info : ttargetinfo;
        target_os   : tosinfo;
@@ -110,10 +112,16 @@ unit systems;
        source_os   : tosinfo;
 
     function set_string_target(const s : string) : boolean;
+    function set_string_asm(const s : string) : boolean;
+
 
-  implementation
+implementation
 
     const
+
+{****************************************************************************
+                                 OS Info
+****************************************************************************}
        os_infos : array[tos] of tosinfo = (
           (
             name         : 'GO32 V1 DOS extender';
@@ -221,61 +229,100 @@ unit systems;
           )
           );
 
+{****************************************************************************
+                             Assembler Info
+****************************************************************************}
        as_infos : array[tasm] of tasminfo = (
           (
-            id     : as_as;
+            id     : as_o;
             idtxt  : 'O';
             asmbin : 'as';
             asmcmd : '-D -o $OBJ $ASM';
+            externals : false;
             labelprefix : '.L';
             comment : '# '
           )
 {$ifdef i386}
           ,(
             id     : as_nasmcoff;
-{$ifdef linux}
-            idtxt  : 'NASM';
-{$else}
             idtxt  : 'NASMCOFF';
-{$endif}
             asmbin : 'nasm';
             asmcmd : '-f coff -o $OBJ $ASM';
+            externals : true;
             labelprefix : 'L';
             comment : '; '
           )
           ,(
             id     : as_nasmelf;
-{$ifdef linux}
-            idtxt  : 'NASM';
-{$else}
             idtxt  : 'NASMELF';
-{$endif}
             asmbin : 'nasm';
             asmcmd : '-f elf -o $OBJ $ASM';
+            externals : true;
             labelprefix : 'L';
             comment : '; '
           )
           ,(
             id     : as_nasmobj;
-            idtxt  : 'OBJ';
+            idtxt  : 'NASMOBJ';
             asmbin : 'nasm';
             asmcmd : '-f obj -o $OBJ $ASM';
+            externals : true;
             labelprefix : 'L';
             comment : '; '
           )
+          ,(
+            id     : as_tasm;
+            idtxt  : 'TASM';
+            asmbin : 'tasm';
+            asmcmd : '/m2 $ASM $OBJ';
+            externals : true;
+            labelprefix : '.L';
+            comment : '; '
+          )
+          ,(
+            id     : as_tasm;
+            idtxt  : 'MASM';
+            asmbin : 'masm';
+            asmcmd : '$ASM $OBJ';
+            externals : true;
+            labelprefix : '.L';
+            comment : '; '
+          )
 {$endif}
 {$ifdef m68k}
           ,(
-            id     : as_as68k;
-            idtxt  : 'O';
+            id     : as_gas;
+            idtxt  : 'GAS';
             asmbin : 'as68k'; { Gas for the Amiga}
             asmcmd : '-D --register-prefix-optional -o $OBJ $ASM';
+            externals : false;
+            labelprefix : '__L';
+            comment : '| '
+          )
+          ,(
+            id     : as_mit;
+            idtxt  : 'MIT';
+            asmbin : '';
+            asmcmd : '-o $OBJ $ASM';
+            externals : false;
+            labelprefix : '__L';
+            comment : '| '
+          )
+          ,(
+            id     : as_mot;
+            idtxt  : 'MOT';
+            asmbin : '';
+            asmcmd : '-o $OBJ $ASM';
+            externals : false;
             labelprefix : '__L';
             comment : '| '
           )
 {$endif}
           );
 
+{****************************************************************************
+                                Linker Info
+****************************************************************************}
        link_infos : array[tlink] of tlinkinfo = (
           (
             linkbin : 'ld';
@@ -341,6 +388,9 @@ unit systems;
 {$endif i386}
           );
 
+{****************************************************************************
+                             Targets Info
+****************************************************************************}
        target_infos : array[ttarget] of ttargetinfo = (
           (
             target      : target_GO32V1;
@@ -354,7 +404,7 @@ unit systems;
             objext      : '.O1';
             os          : os_GO32V1;
             link        : link_ldgo32v1;
-            assem       : as_as
+            assem       : as_o
           ),
           (
             target      : target_GO32V2;
@@ -376,7 +426,7 @@ unit systems;
 {$endif UseAnsiString}
             os          : os_GO32V2;
             link        : link_ldgo32v2;
-            assem       : as_as
+            assem       : as_o
           ),
           (
             target      : target_LINUX;
@@ -390,7 +440,7 @@ unit systems;
             objext      : '.o';
             os          : os_Linux;
             link        : link_ld;
-            assem       : as_as
+            assem       : as_o
           ),
           (
             target      : target_OS2;
@@ -404,7 +454,7 @@ unit systems;
             objext      : '.oo2';
             os          : os_OS2;
             link        : link_ldos2;
-            assem       : as_as
+            assem       : as_o
           ),
           (
             target      : target_WIN32;
@@ -418,7 +468,7 @@ unit systems;
             objext      : '.o';
             os          : os_Win32;
             link        : link_ldw;
-            assem       : as_as
+            assem       : as_o
           ),
           (
             target      : target_Amiga;
@@ -432,7 +482,7 @@ unit systems;
             objext      : '.o';
             os          : os_Amiga;
             link        : link_ld;
-            assem       : as_as
+            assem       : as_o
           ),
           (
             target      : target_Atari;
@@ -446,7 +496,7 @@ unit systems;
             objext      : '.o';
             os          : os_Atari;
             link        : link_ld;
-            assem       : as_as
+            assem       : as_o
           ),
           (
             target      : target_Mac68k;
@@ -460,11 +510,15 @@ unit systems;
             objext      : '.o';
             os          : os_Mac68k;
             link        : link_ld;
-            assem       : as_as
+            assem       : as_o
           )
           );
 
 
+{****************************************************************************
+                                Helpers
+****************************************************************************}
+
 procedure set_target(t : ttarget);
 begin
   target_info:=target_infos[t];
@@ -474,6 +528,9 @@ begin
 end;
 
 
+{****************************************************************************
+                             Load from string
+****************************************************************************}
 
 function set_string_target(const s : string) : boolean;
 var
@@ -489,6 +546,24 @@ begin
 end;
 
 
+function set_string_asm(const s : string) : boolean;
+var
+  j : longint;
+begin
+  set_string_asm:=false;
+  for j:=0 to (sizeof(as_infos) div sizeof(tasminfo))-1 do
+   if as_infos[tasm(j)].idtxt=s then
+    begin
+      target_asm:=as_infos[tasm(j)];
+      set_string_asm:=true;
+    end;
+end;
+
+
+{****************************************************************************
+                      Initialization of default target
+****************************************************************************}
+
 procedure default_os(t:ttarget);
 begin
   set_target(t);
@@ -531,7 +606,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.11  1998-05-22 12:32:49  peter
+  Revision 1.12  1998-05-23 01:21:32  peter
+    + aktasmmode, aktoptprocessor, aktoutputformat
+    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
+    + $LIBNAME to set the library name where the unit will be put in
+    * splitted cgi386 a bit (codeseg to large for bp7)
+    * nasm, tasm works again. nasm moved to ag386nsm.pas
+
+  Revision 1.11  1998/05/22 12:32:49  peter
     * fixed -L on the commandline, Dos commandline is only 128 bytes
 
   Revision 1.10  1998/05/11 13:07:58  peter

compiler/verb_def.pas

@@ -98,7 +98,7 @@ begin
    { Status info?, Called every line }
      if ((Level and V_Status)<>0) and (s='') then
       begin
-        if (abslines=1) then
+        if (status.compiledlines=1) then
           WriteLn(memavail shr 10,' Kb Free');
         if (status.currentline mod 100=0) then
           Write(status.currentline,' ',memavail shr 10,' Kb Free'#13);
@@ -176,7 +176,14 @@ begin
 end.
 {
   $Log$
-  Revision 1.8  1998-05-21 19:33:38  peter
+  Revision 1.9  1998-05-23 01:21:33  peter
+    + aktasmmode, aktoptprocessor, aktoutputformat
+    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
+    + $LIBNAME to set the library name where the unit will be put in
+    * splitted cgi386 a bit (codeseg to large for bp7)
+    * nasm, tasm works again. nasm moved to ag386nsm.pas
+
+  Revision 1.8  1998/05/21 19:33:38  peter
     + better procedure directive handling and only one table
 
   Revision 1.7  1998/05/12 10:47:01  peter

compiler/verbose.pas

@@ -56,16 +56,16 @@ Const
 
 type
   TCompileStatus = record
-    currentsource : string;       { filename }
-    currentline   : longint;      { current line number }
-    totalcompiledlines : longint; { the number of lines which are compiled  }
-    totallines         : longint; { total lines to compile, can be 0 }
+    currentsource : string;   { filename }
+    currentline   : longint;  { current line number }
+    compiledlines : longint;  { the number of lines which are compiled }
+    totallines    : longint;  { total lines to compile, can be 0 }
+    errorcount    : longint;  { number of generated errors }
   end;
 
 
 var
   status      : tcompilestatus;
-  errorcount  : longint;  { number of generated errors }
   msg         : pmessage;
   UseStdErr,
   Use_Rhide   : boolean;
@@ -225,8 +225,8 @@ var
 begin
   dostop:=((l and V_Fatal)<>0);
   if (l and V_Error)<>0 then
-   inc(errorcount);
-  if do_comment(l,s) or dostop or (errorcount>=maxerrorcount) then
+   inc(status.errorcount);
+  if do_comment(l,s) or dostop or (status.errorcount>=maxerrorcount) then
    stop
 end;
 
@@ -255,7 +255,7 @@ begin
                 end;
           'E' : begin
                   v:=v or V_Error;
-                  inc(errorcount);
+                  inc(status.errorcount);
                 end;
           'O' : v:=v or V_Normal;
           'W' : v:=v or V_Warning;
@@ -277,7 +277,7 @@ begin
   Delete(s,1,idx);
   Replace(s,'$VER',version_string);
   Replace(s,'$TARGET',target_string);
-  if do_comment(v,s) or dostop or (errorcount>=maxerrorcount) then
+  if do_comment(v,s) or dostop or (status.errorcount>=maxerrorcount) then
    stop;
 end;
 
@@ -314,7 +314,14 @@ end.
 
 {
   $Log$
-  Revision 1.7  1998-05-21 19:33:40  peter
+  Revision 1.8  1998-05-23 01:21:35  peter
+    + aktasmmode, aktoptprocessor, aktoutputformat
+    + smartlink per module $SMARTLINK-/+ (like MMX) and moved to aktswitches
+    + $LIBNAME to set the library name where the unit will be put in
+    * splitted cgi386 a bit (codeseg to large for bp7)
+    * nasm, tasm works again. nasm moved to ag386nsm.pas
+
+  Revision 1.7  1998/05/21 19:33:40  peter
     + better procedure directive handling and only one table
 
   Revision 1.6  1998/05/12 10:47:01  peter