+ internal inc/dec

compiler/cg386cal.pas

@@ -1353,25 +1353,33 @@ implementation
 *****************************************************************************}
 
     procedure secondinline(var p : ptree);
-     const     in2size:array[in_inc_byte..in_dec_dword] of Topsize=
+     const
+{$ifdef OLDINC}
+               decisize:array[in_inc_byte..in_dec_dword] of Topsize=
                          (S_B,S_W,S_L,S_B,S_W,S_L);
                in2instr:array[in_inc_byte..in_dec_dword] of Tasmop=
                          (A_INC,A_INC,A_INC,A_DEC,A_DEC,A_DEC);
                ad2instr:array[in_inc_byte..in_dec_dword] of Tasmop=
                          (A_ADD,A_ADD,A_ADD,A_SUB,A_SUB,A_SUB);
+{$endif OLDINC}
             { tfloattype = (f32bit,s32real,s64real,s80real,s64bit); }
             float_name: array[tfloattype] of string[8]=
                 ('FIXED','SINGLE','REAL','EXTENDED','COMP','FIXED16');
+            incdecop:array[in_inc_x..in_dec_x] of tasmop=(A_INC,A_DEC);
+            addsubop:array[in_inc_x..in_dec_x] of tasmop=(A_ADD,A_SUB);
        var
          aktfile : treference;
          ft : tfiletype;
          opsize : topsize;
          asmop : tasmop;
          pushed : tpushed;
+         {inc/dec}
+         addconstant : boolean;
+         addvalue : longint;
 
-      { produces code for READ(LN) and WRITE(LN) }
 
       procedure handlereadwrite(doread,callwriteln : boolean);
+      { produces code for READ(LN) and WRITE(LN) }
 
         procedure loadstream;
           const
@@ -1382,8 +1390,7 @@ implementation
             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);
+            concat_external(r^.symbol^,EXT_NEAR);
             exprasmlist^.concat(new(pai386,op_ref_reg(A_LEA,S_L,r,R_EDI)))
           end;
 
@@ -1398,18 +1405,19 @@ implementation
         begin
            { I/O check }
            if cs_iocheck in aktswitches then
-                begin
+             begin
                 getlabel(iolabel);
                 emitl(A_LABEL,iolabel);
              end
-           else iolabel:=nil;
+           else
+             iolabel:=nil;
            { no automatic call from flush }
            doflush:=false;
            { for write of real with the length specified }
            has_length:=false;
            hp:=nil;
            { reserve temporary pointer to data variable }
-             aktfile.symbol:=nil;
+           aktfile.symbol:=nil;
            gettempofsizereference(4,aktfile);
            { first state text data }
            ft:=ft_text;
@@ -1956,6 +1964,77 @@ implementation
                  { could this be usefull I don't think so (PM)
                  emitoverflowcheck;}
               end;
+            in_dec_x,
+            in_inc_x :
+              begin
+              { set defaults }
+                addvalue:=1;
+                addconstant:=true;
+              { load first parameter, must be a reference }
+                secondpass(p^.left^.left);
+                case p^.left^.left^.resulttype^.deftype of
+                  orddef,
+                 enumdef : begin
+                             case p^.left^.left^.resulttype^.size of
+                              1 : opsize:=S_B;
+                              2 : opsize:=S_W;
+                              4 : opsize:=S_L;
+                             end;
+                           end;
+              pointerdef : begin
+                             opsize:=S_L;
+                             addvalue:=ppointerdef(p^.left^.left^.resulttype)^.definition^.savesize;
+                           end;
+                else
+                 internalerror(10081);
+                end;
+              { second argument specified?, must be a s32bit in register }
+                if assigned(p^.left^.right) then
+                 begin
+                   secondpass(p^.left^.right^.left);
+                 { when constant, just multiply the addvalue }
+                   if is_constintnode(p^.left^.right^.left) then
+                    addvalue:=addvalue*get_ordinal_value(p^.left^.right^.left)
+                   else
+                    begin
+                      case p^.left^.right^.left^.location.loc of
+                   LOC_REGISTER,
+                  LOC_CREGISTER : hregister:=p^.left^.right^.left^.location.register;
+                        LOC_MEM,
+                  LOC_REFERENCE : begin
+                                    hregister:=getregister32;
+                                    exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
+                                      newreference(p^.left^.right^.left^.location.reference),hregister)));
+                                  end;
+                       else
+                        internalerror(10082);
+                       end;
+                    { insert multiply with addvalue if its >1 }
+                      if addvalue>1 then
+                       exprasmlist^.concat(new(pai386,op_const_reg(A_IMUL,opsize,
+                         addvalue,hregister)));
+                      addconstant:=false;
+                    end;
+                 end;
+              { write the add instruction }
+                if addconstant then
+                 begin
+                   if (addvalue=1) and not(cs_check_overflow in aktswitches) then
+                    exprasmlist^.concat(new(pai386,op_ref(incdecop[p^.inlinenumber],opsize,
+                      newreference(p^.left^.left^.location.reference))))
+                   else
+                    exprasmlist^.concat(new(pai386,op_const_ref(addsubop[p^.inlinenumber],opsize,
+                      addvalue,newreference(p^.left^.left^.location.reference))));
+                 end
+                else
+                 begin
+                   exprasmlist^.concat(new(pai386,op_reg_ref(addsubop[p^.inlinenumber],opsize,
+                      hregister,newreference(p^.left^.left^.location.reference))));
+                   ungetregister32(hregister);
+                 end;
+                emitoverflowcheck(p^.left^.left);
+              end;
+{$ifdef OLDINC}
             in_inc_byte..in_dec_dword:
               begin
                  secondpass(p^.left);
@@ -1971,6 +2050,7 @@ implementation
                  exprasmlist^.concat(new(pai386,op_ref(in2instr[p^.inlinenumber],
                    in2size[p^.inlinenumber],newreference(p^.left^.location.reference))));
               end;
+{$endif OLDINC}
             in_assigned_x :
               begin
                  secondpass(p^.left^.left);
@@ -2193,7 +2273,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.4  1998-06-25 08:48:06  florian
+  Revision 1.5  1998-06-25 14:04:17  peter
+    + internal inc/dec
+
+  Revision 1.4  1998/06/25 08:48:06  florian
     * first version of rtti support
 
   Revision 1.3  1998/06/09 16:01:33  pierre

compiler/pass_1.pas

@@ -3719,23 +3719,20 @@ unit pass_1;
                    begin
                       firstcallparan(p^.left,nil);
                       { first param must be var }
-                      if p^.left^.left^.location.loc<>LOC_REFERENCE then
+                      if not (p^.left^.left^.location.loc in [LOC_MEM,LOC_REFERENCE]) then
                         Message(cg_e_illegal_expression);
                       { check type }
-                      if (p^.left^.resulttype^.deftype=pointerdef) or
-                        (p^.left^.resulttype^.deftype=enumdef) or
-                        ( (p^.left^.resulttype^.deftype=orddef) and
-                          (porddef(p^.left^.resulttype)^.typ in [u8bit,s8bit,u16bit,s16bit,u32bit,s32bit])
-                        ) then
+                      if (p^.left^.resulttype^.deftype in [enumdef,pointerdef]) or
+                         ((p^.left^.resulttype^.deftype=orddef) and
+                          (porddef(p^.left^.resulttype)^.typ in [bool8bit,u8bit,s8bit,
+                             bool16bit,u16bit,s16bit,bool32bit,u32bit,s32bit])) then
                         begin
                            { two paras ? }
                            if assigned(p^.left^.right) then
                              begin
                                 { insert a type conversion         }
                                 { the second param is always longint }
-                                p^.left^.right^.left:=gentypeconvnode(
-                                  p^.left^.right^.left,
-                                  s32bitdef);
+                                p^.left^.right^.left:=gentypeconvnode(p^.left^.right^.left,s32bitdef);
                                 { check the type conversion }
                                 firstpass(p^.left^.right^.left);
                                 if assigned(p^.left^.right^.right) then
@@ -3810,10 +3807,10 @@ unit pass_1;
                                      end
                                    else if hp^.left^.resulttype^.deftype=orddef then
                                      case porddef(hp^.left^.resulttype)^.typ of
-                                       u8bit,s8bit,
-                                       u16bit,s16bit :
-                                         hp^.left:=gentypeconvnode(hp^.left,s32bitdef);
-                                       end
+                                         u8bit,s8bit,
+                                       u16bit,s16bit : hp^.left:=gentypeconvnode(hp^.left,s32bitdef);
+                                 bool16bit,bool32bit : hp^.left:=gentypeconvnode(hp^.left,booldef);
+                                     end
                                    { but we convert only if the first index<>0, because in this case }
                                    { we have a ASCIIZ string                                         }
                                    else if (hp^.left^.resulttype^.deftype=arraydef) and
@@ -4408,7 +4405,7 @@ unit pass_1;
          if codegenerror then
            exit;
          if not((p^.left^.resulttype^.deftype=orddef) and
-            (porddef(p^.left^.resulttype)^.typ=bool8bit)) then
+            (porddef(p^.left^.resulttype)^.typ in [bool8bit,bool16bit,bool32bit])) then
             begin
                Message(sym_e_type_mismatch);
                exit;
@@ -5047,7 +5044,10 @@ unit pass_1;
 end.
 {
   $Log$
-  Revision 1.34  1998-06-25 08:48:14  florian
+  Revision 1.35  1998-06-25 14:04:19  peter
+    + internal inc/dec
+
+  Revision 1.34  1998/06/25 08:48:14  florian
     * first version of rtti support
 
   Revision 1.33  1998/06/16 08:56:24  peter

compiler/pdecl.pas

@@ -183,25 +183,26 @@ unit pdecl;
       var
          sc : pstringcontainer;
          s : stringid;
+         old_block_type : tblock_type;
+         filepos : tfileposinfo;
+         symdone : boolean;
+         { to handle absolute }
+         abssym : pabsolutesym;
+{$ifdef i386}	 
          l    : longint;
          code : word;
-         hs : string;
+{$endif i386}
+         { c var }
+         Csym : pvarsym;
+         is_cdecl,extern_Csym,export_Csym : boolean;
+         C_name : string;
+	 { case }
          p,casedef : pdef;
          { maxsize contains the max. size of a variant }
          { startvarrec contains the start of the variant part of a record }
          maxsize,startvarrec : longint;
          pt : ptree;
-         old_block_type : tblock_type;
-         { to handle absolute }
-         abssym : pabsolutesym;
-         filepos : tfileposinfo;
-
-         Csym : pvarsym;
-         is_cdecl,extern_Csym,export_Csym : boolean;
-         C_name : string;
-         symdone : boolean;
       begin
-         hs:='';
          old_block_type:=block_type;
          block_type:=bt_type;
        { Force an expected ID error message }
@@ -1859,7 +1860,10 @@ unit pdecl;
 end.
 {
   $Log$
-  Revision 1.28  1998-06-24 12:26:45  peter
+  Revision 1.29  1998-06-25 14:04:21  peter
+    + internal inc/dec
+
+  Revision 1.28  1998/06/24 12:26:45  peter
     * stricter var parsing like tp7 and some optimizes with directive
       parsing
 

compiler/pexpr.pas

@@ -290,14 +290,15 @@ unit pexpr;
                           consume(LKLAMMER);
                           in_args:=true;
                           p1:=comp_expr(true);
-                          p2:=gencallparanode(p1,nil);
                           Must_be_valid:=false;
                           if token=COMMA then
-                            begin
-                               consume(COMMA);
-                               p1:=comp_expr(true);
-                               p2:=gencallparanode(p1,p2);
-                            end;
+                           begin
+                             consume(COMMA);
+                             p2:=gencallparanode(comp_expr(true),nil);
+                           end
+                          else
+                           p2:=nil;
+                          p2:=gencallparanode(p1,p2);
                           statement_syssym:=geninlinenode(l,p2);
                           consume(RKLAMMER);
                           pd:=voiddef;
@@ -745,7 +746,7 @@ unit pexpr;
                                else
                                  begin
                                     p2:=comp_expr(true);
-{$ifdef i386}                           
+{$ifdef i386}
 
                                   { support SEG:OFS for go32v2 Mem[] }
                                     if (target_info.target=target_GO32V2) and
@@ -774,7 +775,7 @@ unit pexpr;
                                          end;
                                       end
                                     else
-{$endif}                                
+{$endif}
 
                                       p1:=gennode(vecn,p1,p2);
                                     if pd^.deftype=stringdef then
@@ -1786,7 +1787,10 @@ unit pexpr;
 end.
 {
   $Log$
-  Revision 1.26  1998-06-09 16:01:46  pierre
+  Revision 1.27  1998-06-25 14:04:23  peter
+    + internal inc/dec
+
+  Revision 1.26  1998/06/09 16:01:46  pierre
     + added procedure directive parsing for procvars
       (accepted are popstack cdecl and pascal)
     + added C vars with the following syntax

compiler/psystem.pas

@@ -58,9 +58,10 @@ begin
   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)));
+{$ifndef OLDINC}
+  p^.insert(new(psyssym,init('DEC',in_dec_x)));
+  p^.insert(new(psyssym,init('INC',in_inc_x)));
+{$endif}
   p^.insert(new(psyssym,init('STR',in_str_x_string)));
 end;
 
@@ -231,7 +232,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.3  1998-06-04 23:51:55  peter
+  Revision 1.4  1998-06-25 14:04:24  peter
+    + internal inc/dec
+
+  Revision 1.3  1998/06/04 23:51:55  peter
     * m68k compiles
     + .def file creation moved to gendef.pas so it could also be used
       for win32

rtl/inc/system.inc

@@ -62,6 +62,7 @@ Function  lo(l : Longint) : Word;  [INTERNPROC: In_lo_long];
 Function  hi(i : Integer) : byte;  [INTERNPROC: In_hi_Word];
 Function  hi(w : Word) : byte;     [INTERNPROC: In_hi_Word];
 Function  hi(l : Longint) : Word;  [INTERNPROC: In_hi_long];
+{$ifndef INTERN_INC}
 Procedure Inc(var i : Cardinal);   [INTERNPROC: In_Inc_DWord];
 Procedure Inc(var i : Longint);    [INTERNPROC: In_Inc_DWord];
 Procedure Inc(var i : Integer);    [INTERNPROC: In_Inc_Word];
@@ -78,6 +79,7 @@ Procedure Dec(var i : shortint);   [INTERNPROC: In_Dec_byte];
 Procedure Dec(var i : byte);       [INTERNPROC: In_Dec_byte];
 Procedure Dec(var c : Char);       [INTERNPROC: In_Dec_byte];
 Procedure Dec(var p : PChar);      [INTERNPROC: In_Dec_DWord];
+{$endif INTERN_INC}
 
 Function chr(b : byte) : Char;      [INTERNPROC: In_chr_byte];
 Function Length(s : string) : byte; [INTERNPROC: In_Length_string];
@@ -110,11 +112,11 @@ Procedure Rewrite(var f : TypedFile); [INTERNPROC: In_Rewrite_TypedFile];
 { Provide dummy procedures needed for rtti}
 Procedure decr_ansi_ref (P : pointer);[Alias : 'DECR_ANSI_REF'];
   begin
-  end; 
+  end;
 
 Procedure incr_ansi_ref (P : pointer);[Alias : 'INCR_ANSI_REF'];
   begin
-  end; 
+  end;
 
 {$endif}
 
@@ -123,9 +125,9 @@ Procedure incr_ansi_ref (P : pointer);[Alias : 'INCR_ANSI_REF'];
 		     Run-Time Type Information (RTTI)
 ****************************************************************************}
 
-
 {$i rtti.inc}
 
+
 {****************************************************************************
                                Math Routines
 ****************************************************************************}
@@ -142,6 +144,8 @@ begin
    Lo := b and $0f
 end;
 
+{$ifndef INTERN_INC}
+
 Procedure Inc(var i : Cardinal;a: Longint);
 Begin
   I:=I+A;
@@ -222,6 +226,8 @@ Begin
   longint(p):=longint(p)+a;
 End;
 
+{$endif INTERN_INC}
+
 Function swap (X : Word) : Word;
 Begin
   swap:=(X and $ff) shl 8 + (X shr 8)
@@ -262,7 +268,7 @@ End;
 {$I math.inc}
 
 {****************************************************************************
-							 Memory Management
+                                                         Memory Management
 ****************************************************************************}
 
 {$ifndef RTLLITE}
@@ -296,7 +302,7 @@ End;
 {$endif RTLLITE}
 
 {*****************************************************************************
-							 Miscellaneous
+                                                         Miscellaneous
 *****************************************************************************}
 
 
@@ -434,7 +440,10 @@ End;
 
 {
   $Log$
-  Revision 1.11  1998-06-25 09:44:20  daniel
+  Revision 1.12  1998-06-25 14:04:25  peter
+    + internal inc/dec
+
+  Revision 1.11  1998/06/25 09:44:20  daniel
   + RTLLITE directive to compile minimal RTL.
 
   Revision 1.10  1998/06/15 15:16:26  daniel

rtl/inc/systemh.inc

@@ -104,7 +104,7 @@ Procedure FillWord(Var x;count:Longint;Value:Word);
 {$endif RTLLITE}
 
 {****************************************************************************
-							   Math Routines
+                                                           Math Routines
 ****************************************************************************}
 
 {$ifndef RTLLITE}
@@ -116,9 +116,12 @@ Function  hi(w:Word):byte;
 Function  hi(i:Integer):byte;
 Function  hi(l:Longint):Word;
 Function  Hi(B : Byte): byte;
+Function  Swap (X:Word):Word;
+Function  Swap (X:Integer):Integer;
+Function  Swap (X:Cardinal):Cardinal;
+Function  Swap (X:Longint):Longint;
 
-{$endif RTLLITE}
-
+{$ifndef INTERN_INC}
 Procedure Inc(Var i:cardinal);
 Procedure Inc(Var i:Longint);
 Procedure Inc(Var i:Integer);
@@ -135,11 +138,6 @@ Procedure Dec(Var i:shortint);
 Procedure Dec(Var i:byte);
 Procedure Dec(Var c:Char);
 Procedure Dec(Var p:PChar);
-Function Chr(b:byte):Char;
-Function Length(s:string):byte;
-
-{$ifndef RTLLITE}
-
 Procedure Dec(Var i:cardinal;a:Longint);
 Procedure Inc(Var i:cardinal;a:Longint);
 Procedure Dec(Var i:Longint;a:Longint);
@@ -156,12 +154,11 @@ Procedure Dec(Var c:Char;a:Longint);
 Procedure Inc(Var c:Char;a:Longint);
 Procedure Dec(Var p:PChar;a:Longint);
 Procedure Inc(Var p:PChar;a:Longint);
-Function  Swap (X:Word):Word;
-Function  Swap (X:Integer):Integer;
-Function  Swap (X:Cardinal):Cardinal;
-Function  Swap (X:Longint):Longint;
+{$endif INTERN_INC}
 
 {$endif RTLLITE}
+Function Chr(b:byte):Char;
+Function Length(s:string):byte;
 
 Function  Random(l:Longint):Longint;
 Function  Random:real;
@@ -175,7 +172,7 @@ Function odd(l:Longint):Boolean;
 
 
 {****************************************************************************
-							 Memory management
+                                                         Memory management
 ****************************************************************************}
 
 Procedure getmem(Var p:pointer;Size:Longint);
@@ -192,7 +189,7 @@ Function  Sseg:Word;
 {$endif RTLLITE}
 
 {****************************************************************************
-							  PChar Handling
+                                                          PChar Handling
 ****************************************************************************}
 
 function strpas(p:pchar):string;
@@ -254,34 +251,34 @@ Procedure Val(const s:string;Var v:cardinal);
 
 {$ifdef UseAnsiStrings }
 
-Procedure SetLength (Var S : AnsiString; l : Longint); 
-Procedure UniqueAnsiString (Var S : AnsiString); 
-Function  Length (Const S : AnsiString) : Longint; 
-Function  Copy (Const S : AnsiString; Index,Size : Longint) : AnsiString; 
-Function  Pos (Const Substr : AnsiString; Const Source : AnsiString) : Longint; 
-Procedure Insert (Const Source : AnsiString; Var S : AnsiString; Index : Longint); 
-Procedure Delete (Var S : AnsiString; Index,Size: Longint); 
-Procedure Val (Const S : AnsiString; var R : real; Var Code : Integer); 
+Procedure SetLength (Var S : AnsiString; l : Longint);
+Procedure UniqueAnsiString (Var S : AnsiString);
+Function  Length (Const S : AnsiString) : Longint;
+Function  Copy (Const S : AnsiString; Index,Size : Longint) : AnsiString;
+Function  Pos (Const Substr : AnsiString; Const Source : AnsiString) : Longint;
+Procedure Insert (Const Source : AnsiString; Var S : AnsiString; Index : Longint);
+Procedure Delete (Var S : AnsiString; Index,Size: Longint);
+Procedure Val (Const S : AnsiString; var R : real; Var Code : Integer);
 {
 Procedure Val (Const S : AnsiString; var D : Double; Var Code : Integer);
 }
-Procedure Val (Const S : AnsiString; var E : Extended; Code : Integer); 
-Procedure Val (Const S : AnsiString; var C : Cardinal; Code : Integer); 
+Procedure Val (Const S : AnsiString; var E : Extended; Code : Integer);
+Procedure Val (Const S : AnsiString; var C : Cardinal; Code : Integer);
 Procedure Val (Const S : AnsiString; var L : Longint; Var Code : Integer);
 Procedure Val (Const S : AnsiString; var W : Word; Var Code : Integer);
-Procedure Val (Const S : AnsiString; var I : Integer; Var Code : Integer); 
-Procedure Val (Const S : AnsiString; var B : Byte; Var Code : Integer); 
-Procedure Val (Const S : AnsiString; var SI : ShortInt; Var  Code : Integer); 
+Procedure Val (Const S : AnsiString; var I : Integer; Var Code : Integer);
+Procedure Val (Const S : AnsiString; var B : Byte; Var Code : Integer);
+Procedure Val (Const S : AnsiString; var SI : ShortInt; Var  Code : Integer);
 {
-Procedure Str (Const R : Real;Len, fr : longint; Var S : AnsiString); 
+Procedure Str (Const R : Real;Len, fr : longint; Var S : AnsiString);
 Procedure Str (Const D : Double;Len,fr : longint; Var S : AnsiString);
-Procedure Str (Const E : Extended;Len,fr : longint; Var S : AnsiString); 
-Procedure Str (Const C : Cardinal;len : Longint; Var S : AnsiString); 
-Procedure Str (Const L : LongInt;len : longint; Var S : AnsiString); 
-Procedure Str (Const W : Word;len : longint; Var S : AnsiString); 
-Procedure Str (Const I : Integer;len : Longint; Var S : AnsiString); 
-Procedure Str (Const B : Byte; Len : longint; Var S : AnsiString); 
-Procedure Str (Const SI : ShortInt; Len : longint; Var S : AnsiString); 
+Procedure Str (Const E : Extended;Len,fr : longint; Var S : AnsiString);
+Procedure Str (Const C : Cardinal;len : Longint; Var S : AnsiString);
+Procedure Str (Const L : LongInt;len : longint; Var S : AnsiString);
+Procedure Str (Const W : Word;len : longint; Var S : AnsiString);
+Procedure Str (Const I : Integer;len : Longint; Var S : AnsiString);
+Procedure Str (Const B : Byte; Len : longint; Var S : AnsiString);
+Procedure Str (Const SI : ShortInt; Len : longint; Var S : AnsiString);
 }
 {$endif}
 
@@ -389,7 +386,10 @@ Procedure halt;
 
 {
   $Log$
-  Revision 1.13  1998-06-25 09:44:21  daniel
+  Revision 1.14  1998-06-25 14:04:26  peter
+    + internal inc/dec
+
+  Revision 1.13  1998/06/25 09:44:21  daniel
   + RTLLITE directive to compile minimal RTL.
 
   Revision 1.12  1998/06/15 15:16:27  daniel