* first things for default parameters

compiler/cobjects.pas

@@ -175,6 +175,8 @@ unit cobjects;
           destructor  done;
           { true when the container is empty }
           function  empty:boolean;
+          { amount of strings in the container }
+          function  count:longint;
           { inserts a string }
           procedure insert(item:pcontaineritem);
           { gets a string }
@@ -909,6 +911,22 @@ end;
       end;
 
 
+    function tcontainer.count:longint;
+      var
+        i : longint;
+        p : pcontaineritem;
+      begin
+        i:=0;
+        p:=root;
+        while assigned(p) do
+         begin
+           p:=p^.next;
+           inc(i);
+         end;
+        count:=i;
+      end;
+
+
     procedure tcontainer.insert(item:pcontaineritem);
       begin
          item^.next:=nil;
@@ -2393,7 +2411,10 @@ end;
 end.
 {
   $Log$
-  Revision 1.2  2000-07-13 11:32:38  michael
+  Revision 1.3  2000-08-02 19:49:58  peter
+    * first things for default parameters
+
+  Revision 1.2  2000/07/13 11:32:38  michael
   + removed logs
 
 }

compiler/globals.pas

@@ -64,13 +64,14 @@ unit globals;
 
        delphimodeswitches : tmodeswitches=
          [m_delphi,m_tp,m_all,m_class,m_objpas,m_result,m_string_pchar,
-          m_pointer_2_procedure,m_autoderef,m_tp_procvar,m_initfinal,m_default_ansistring,m_out];
+          m_pointer_2_procedure,m_autoderef,m_tp_procvar,m_initfinal,m_default_ansistring,
+          m_out,m_default_para];
        fpcmodeswitches    : tmodeswitches=
          [m_fpc,m_all,m_string_pchar,m_nested_comment,m_repeat_forward,
           m_cvar_support,m_initfinal,m_add_pointer];
        objfpcmodeswitches : tmodeswitches=
          [m_objfpc,m_fpc,m_all,m_class,m_objpas,m_result,m_string_pchar,m_nested_comment,
-          m_repeat_forward,m_cvar_support,m_initfinal,m_add_pointer,m_out];
+          m_repeat_forward,m_cvar_support,m_initfinal,m_add_pointer,m_out,m_default_para];
        tpmodeswitches     : tmodeswitches=
          [m_tp7,m_tp,m_all,m_tp_procvar];
        gpcmodeswitches    : tmodeswitches=
@@ -1587,7 +1588,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.3  2000-07-13 12:08:25  michael
+  Revision 1.4  2000-08-02 19:49:59  peter
+    * first things for default parameters
+
+  Revision 1.3  2000/07/13 12:08:25  michael
   + patched to 1.1.0 with former 1.09patch from peter
 
   Revision 1.2  2000/07/13 11:32:41  michael

compiler/globtype.pas

@@ -129,7 +129,8 @@ interface
          m_initfinal,           { initialization/finalization for units }
          m_add_pointer,         { allow pointer add/sub operations }
          m_default_ansistring,  { ansistring turned on by default }
-         m_out                  { support the calling convention OUT }
+         m_out,                 { support the calling convention OUT }
+         m_default_para         { support default parameters }
        );
        tmodeswitches = set of tmodeswitch;
 
@@ -200,7 +201,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.3  2000-07-13 12:08:25  michael
+  Revision 1.4  2000-08-02 19:49:59  peter
+    * first things for default parameters
+
+  Revision 1.3  2000/07/13 12:08:25  michael
   + patched to 1.1.0 with former 1.09patch from peter
 
   Revision 1.2  2000/07/13 11:32:41  michael

compiler/pdecl.pas

@@ -61,11 +61,79 @@ unit pdecl;
 {$else}
        ,hcodegen
 {$endif}
-
        ,hcgdata
        ;
 
 
+    function readconstant(const name:string;const filepos:tfileposinfo):pconstsym;
+      var
+        hp : pconstsym;
+        p : ptree;
+        ps : pconstset;
+        pd : pbestreal;
+        sp : pchar;
+        storetokenpos : tfileposinfo;
+      begin
+        readconstant:=nil;
+        if name='' then
+         internalerror(9584582);
+        hp:=nil;
+        p:=comp_expr(true);
+        do_firstpass(p);
+        storetokenpos:=tokenpos;
+        tokenpos:=filepos;
+        case p^.treetype of
+           ordconstn:
+             begin
+                if is_constintnode(p) then
+                  hp:=new(pconstsym,init_def(name,constint,p^.value,nil))
+                else if is_constcharnode(p) then
+                  hp:=new(pconstsym,init_def(name,constchar,p^.value,nil))
+                else if is_constboolnode(p) then
+                  hp:=new(pconstsym,init_def(name,constbool,p^.value,nil))
+                else if p^.resulttype^.deftype=enumdef then
+                  hp:=new(pconstsym,init_def(name,constord,p^.value,p^.resulttype))
+                else if p^.resulttype^.deftype=pointerdef then
+                  hp:=new(pconstsym,init_def(name,constord,p^.value,p^.resulttype))
+                else internalerror(111);
+             end;
+           stringconstn:
+             begin
+                getmem(sp,p^.length+1);
+                move(p^.value_str^,sp^,p^.length+1);
+                hp:=new(pconstsym,init_string(name,conststring,sp,p^.length));
+             end;
+           realconstn :
+             begin
+                new(pd);
+                pd^:=p^.value_real;
+                hp:=new(pconstsym,init(name,constreal,longint(pd)));
+             end;
+           setconstn :
+             begin
+               new(ps);
+               ps^:=p^.value_set^;
+               hp:=new(pconstsym,init_def(name,constset,longint(ps),p^.resulttype));
+             end;
+           pointerconstn :
+             begin
+               hp:=new(pconstsym,init_def(name,constpointer,p^.value,p^.resulttype));
+             end;
+           niln :
+             begin
+               hp:=new(pconstsym,init_def(name,constnil,0,p^.resulttype));
+             end;
+           else
+             Message(cg_e_illegal_expression);
+        end;
+        if assigned(hp) then
+         symtablestack^.insert(hp);
+        tokenpos:=storetokenpos;
+        disposetree(p);
+        readconstant:=hp;
+      end;
+
+
     procedure parameter_dec(aktprocdef:pabstractprocdef);
       {
         handle_procvar needs the same changes
@@ -74,6 +142,7 @@ unit pdecl;
         is_procvar : boolean;
         sc      : Pstringcontainer;
         s       : string;
+        hpos,
         storetokenpos : tfileposinfo;
         tt      : ttype;
         hvs,
@@ -81,7 +150,11 @@ unit pdecl;
         hs1,hs2 : string;
         varspez : Tvarspez;
         inserthigh : boolean;
+        pdefaultvalue : pconstsym;
+        defaultrequired : boolean;
       begin
+        { reset }
+        defaultrequired:=false;
         { parsing a proc or procvar ? }
         is_procvar:=(aktprocdef^.deftype=procvardef);
         consume(_LKLAMMER);
@@ -98,6 +171,7 @@ unit pdecl;
           else
               varspez:=vs_value;
           inserthigh:=false;
+          pdefaultvalue:=nil;
           tt.reset;
           { self is only allowed in procvars and class methods }
           if (idtoken=_SELF) and
@@ -121,7 +195,7 @@ unit pdecl;
               consume(idtoken);
               consume(_COLON);
               single_type(tt,hs1,false);
-              aktprocdef^.concatpara(tt,vs_value);
+              aktprocdef^.concatpara(tt,vs_value,nil);
               { check the types for procedures only }
               if not is_procvar then
                CheckTypes(tt.def,procinfo^._class);
@@ -164,24 +238,48 @@ unit pdecl;
                       end;
                      inserthigh:=true;
                    end
-                  { open string ? }
-                  else if (varspez=vs_var) and
-                          (
-                            (
-                              ((token=_STRING) or (idtoken=_SHORTSTRING)) and
-                              (cs_openstring in aktmoduleswitches) and
-                              not(cs_ansistrings in aktlocalswitches)
-                            ) or
-                          (idtoken=_OPENSTRING)) then
-                   begin
-                     consume(token);
-                     tt.setdef(openshortstringdef);
-                     hs1:='openstring';
-                     inserthigh:=true;
-                   end
-                  { everything else }
                   else
-                   single_type(tt,hs1,false);
+                   begin
+                     { open string ? }
+                     if (varspez=vs_var) and
+                             (
+                               (
+                                 ((token=_STRING) or (idtoken=_SHORTSTRING)) and
+                                 (cs_openstring in aktmoduleswitches) and
+                                 not(cs_ansistrings in aktlocalswitches)
+                               ) or
+                             (idtoken=_OPENSTRING)) then
+                      begin
+                        consume(token);
+                        tt.setdef(openshortstringdef);
+                        hs1:='openstring';
+                        inserthigh:=true;
+                      end
+                     else
+                      begin
+                        { everything else }
+                        single_type(tt,hs1,false);
+                      end;
+                     { default parameter }
+                     if (m_default_para in aktmodeswitches) then
+                      begin
+                        if try_to_consume(_EQUAL) then
+                         begin
+                           s:=sc^.get_with_tokeninfo(hpos);
+                           if not sc^.empty then
+                            Comment(V_Error,'default value only allowed for one parameter');
+                           sc^.insert_with_tokeninfo(s,hpos);
+                           s:=lower(aktprocsym^.name+'.'+s);
+                           pdefaultvalue:=ReadConstant(s,hpos);
+                           defaultrequired:=true;
+                         end
+                        else
+                         begin
+                           if defaultrequired then
+                            Comment(V_Error,'default parameter required');
+                         end;
+                      end;
+                   end;
                 end
                else
                 begin
@@ -198,7 +296,7 @@ unit pdecl;
                while not sc^.empty do
                 begin
                   s:=sc^.get_with_tokeninfo(tokenpos);
-                  aktprocdef^.concatpara(tt,varspez);
+                  aktprocdef^.concatpara(tt,varspez,pdefaultvalue);
                   { For proc vars we only need the definitions }
                   if not is_procvar then
                    begin
@@ -722,14 +820,10 @@ unit pdecl;
     procedure const_dec;
       var
          name : stringid;
-         p : ptree;
          tt  : ttype;
          sym : psym;
          storetokenpos,filepos : tfileposinfo;
          old_block_type : tblock_type;
-         ps : pconstset;
-         pd : pbestreal;
-         sp : pchar;
          skipequal : boolean;
       begin
          consume(_CONST);
@@ -744,57 +838,8 @@ unit pdecl;
              _EQUAL:
                 begin
                    consume(_EQUAL);
-                   p:=comp_expr(true);
-                   do_firstpass(p);
-                   storetokenpos:=tokenpos;
-                   tokenpos:=filepos;
-                   case p^.treetype of
-                      ordconstn:
-                        begin
-                           if is_constintnode(p) then
-                             symtablestack^.insert(new(pconstsym,init_def(name,constint,p^.value,nil)))
-                           else if is_constcharnode(p) then
-                             symtablestack^.insert(new(pconstsym,init_def(name,constchar,p^.value,nil)))
-                           else if is_constboolnode(p) then
-                             symtablestack^.insert(new(pconstsym,init_def(name,constbool,p^.value,nil)))
-                           else if p^.resulttype^.deftype=enumdef then
-                             symtablestack^.insert(new(pconstsym,init_def(name,constord,p^.value,p^.resulttype)))
-                           else if p^.resulttype^.deftype=pointerdef then
-                             symtablestack^.insert(new(pconstsym,init_def(name,constord,p^.value,p^.resulttype)))
-                           else internalerror(111);
-                        end;
-                      stringconstn:
-                        begin
-                           getmem(sp,p^.length+1);
-                           move(p^.value_str^,sp^,p^.length+1);
-                           symtablestack^.insert(new(pconstsym,init_string(name,conststring,sp,p^.length)));
-                        end;
-                      realconstn :
-                        begin
-                           new(pd);
-                           pd^:=p^.value_real;
-                           symtablestack^.insert(new(pconstsym,init(name,constreal,longint(pd))));
-                        end;
-                      setconstn :
-                        begin
-                          new(ps);
-                          ps^:=p^.value_set^;
-                          symtablestack^.insert(new(pconstsym,init_def(name,constset,longint(ps),p^.resulttype)));
-                        end;
-                      pointerconstn :
-                        begin
-                          symtablestack^.insert(new(pconstsym,init_def(name,constpointer,p^.value,p^.resulttype)))
-                        end;
-                      niln :
-                        begin
-                          symtablestack^.insert(new(pconstsym,init_def(name,constnil,0,p^.resulttype)));
-                        end;
-                      else
-                        Message(cg_e_illegal_expression);
-                   end;
-                   tokenpos:=storetokenpos;
+                   readconstant(name,filepos);
                    consume(_SEMICOLON);
-                   disposetree(p);
                 end;
 
              _COLON:
@@ -1228,7 +1273,10 @@ unit pdecl;
 end.
 {
   $Log$
-  Revision 1.5  2000-07-30 17:04:43  peter
+  Revision 1.6  2000-08-02 19:49:59  peter
+    * first things for default parameters
+
+  Revision 1.5  2000/07/30 17:04:43  peter
     * merged fixes
 
   Revision 1.4  2000/07/14 05:11:49  michael

compiler/symdef.inc

@@ -2387,7 +2387,7 @@
       end;
 
 
-    procedure tabstractprocdef.concatpara(tt:ttype;vsp : tvarspez);
+    procedure tabstractprocdef.concatpara(tt:ttype;vsp : tvarspez;defval:psym);
       var
         hp : pparaitem;
       begin
@@ -2395,6 +2395,7 @@
         hp^.paratyp:=vsp;
         hp^.paratype:=tt;
         hp^.register:=R_NO;
+        hp^.defaultvalue:=defval;
         para^.insert(hp);
       end;
 
@@ -4187,10 +4188,13 @@ Const local_symtable_index : longint = $8001;
 
 {
   $Log$
-  Revision 1.3  2000-07-13 12:08:27  michael
+  Revision 1.4  2000-08-02 19:49:59  peter
+    * first things for default parameters
+
+  Revision 1.3  2000/07/13 12:08:27  michael
   + patched to 1.1.0 with former 1.09patch from peter
 
   Revision 1.2  2000/07/13 11:32:49  michael
   + removed logs
- 
+
 }

compiler/symdefh.inc

@@ -95,6 +95,7 @@
           argconvtyp   : targconvtyp;
           convertlevel : byte;
           register     : tregister;
+          defaultvalue : psym; { pconstsym }
        end;
 
        tfiletyp = (ft_text,ft_typed,ft_untyped);
@@ -352,7 +353,7 @@
           destructor done;virtual;
           procedure  write;virtual;
           procedure deref;virtual;
-          procedure concatpara(tt:ttype;vsp : tvarspez);
+          procedure concatpara(tt:ttype;vsp : tvarspez;defval:psym);
           function  para_size(alignsize:longint) : longint;
           function  demangled_paras : string;
           function  proccalloption2str : string;
@@ -534,10 +535,13 @@
 
 {
   $Log$
-  Revision 1.3  2000-07-13 12:08:27  michael
+  Revision 1.4  2000-08-02 19:49:59  peter
+    * first things for default parameters
+
+  Revision 1.3  2000/07/13 12:08:27  michael
   + patched to 1.1.0 with former 1.09patch from peter
 
   Revision 1.2  2000/07/13 11:32:49  michael
   + removed logs
- 
+
 }

compiler/tcmem.pas

@@ -275,7 +275,7 @@ implementation
                        hp2:=pparaitem(hp3^.para^.last);
                        while assigned(hp2) do
                          begin
-                            pprocvardef(p^.resulttype)^.concatpara(hp2^.paratype,hp2^.paratyp);
+                            pprocvardef(p^.resulttype)^.concatpara(hp2^.paratype,hp2^.paratyp,hp2^.defaultvalue);
                             hp2:=pparaitem(hp2^.previous);
                          end;
                     end
@@ -642,7 +642,10 @@ implementation
 end.
 {
   $Log$
-  Revision 1.3  2000-07-13 12:08:28  michael
+  Revision 1.4  2000-08-02 19:49:59  peter
+    * first things for default parameters
+
+  Revision 1.3  2000/07/13 12:08:28  michael
   + patched to 1.1.0 with former 1.09patch from peter
 
   Revision 1.2  2000/07/13 11:32:52  michael