+ support iso pascal like program parameters in iso mode

git-svn-id: trunk@26437 -

compiler/ngenutil.pas

@@ -68,6 +68,11 @@ interface
       { trashing for differently sized variables that those handled by
         trash_small() }
       class procedure trash_large(var stat: tstatementnode; trashn, sizen: tnode; trashintval: int64); virtual;
+
+      { initialization of iso styled program parameters }
+      class procedure initialize_textrec(p : TObject; statn : pointer);
+      { finalization of iso styled program parameters }
+      class procedure finalize_textrec(p : TObject; statn : pointer);
      public
       class procedure insertbssdata(sym : tstaticvarsym); virtual;
 
@@ -260,6 +265,42 @@ implementation
     end;
 
 
+  class procedure tnodeutils.initialize_textrec(p:TObject;statn:pointer);
+    var
+      stat: ^tstatementnode absolute statn;
+    begin
+      if (tsym(p).typ=staticvarsym) and
+       (tstaticvarsym(p).vardef.typ=filedef) and
+       (tfiledef(tstaticvarsym(p).vardef).filetyp=ft_text) and
+       (tstaticvarsym(p).isoindex<>0) then
+       begin
+         addstatement(stat^,ccallnode.createintern('fpc_textinit_iso',
+           ccallparanode.create(
+             cordconstnode.create(tstaticvarsym(p).isoindex,uinttype,false),
+           ccallparanode.create(
+             cloadnode.create(tstaticvarsym(p),tstaticvarsym(p).Owner),
+           nil))));
+       end;
+    end;
+
+
+  class procedure tnodeutils.finalize_textrec(p:TObject;statn:pointer);
+    var
+      stat: ^tstatementnode absolute statn;
+    begin
+      if (tsym(p).typ=staticvarsym) and
+       (tstaticvarsym(p).vardef.typ=filedef) and
+       (tfiledef(tstaticvarsym(p).vardef).filetyp=ft_text) and
+       (tstaticvarsym(p).isoindex<>0) then
+       begin
+         addstatement(stat^,ccallnode.createintern('fpc_textclose_iso',
+           ccallparanode.create(
+             cloadnode.create(tstaticvarsym(p),tstaticvarsym(p).Owner),
+           nil)));
+       end;
+    end;
+
+
   class function tnodeutils.wrap_proc_body(pd: tprocdef; n: tnode): tnode;
     var
       stat: tstatementnode;
@@ -267,6 +308,17 @@ implementation
       psym: tsym;
     begin
       result:=maybe_insert_trashing(pd,n);
+
+      if (m_iso in current_settings.modeswitches) and
+        (pd.proctypeoption=potype_proginit) then
+        begin
+          block:=internalstatements(stat);
+          pd.localst.SymList.ForEachCall(@initialize_textrec,@stat);
+          addstatement(stat,result);
+          pd.localst.SymList.ForEachCall(@finalize_textrec,@stat);
+          result:=block;
+        end;
+
       if target_info.system in systems_typed_constants_node_init then
         begin
           case pd.proctypeoption of

compiler/pmodules.pas

@@ -1888,6 +1888,11 @@ type
 
 
     procedure proc_program(islibrary : boolean);
+      type
+        TProgramParam = record
+          name : ansistring;
+          nr : dword;
+        end;
       var
          main_file : tinputfile;
          hp,hp2    : tmodule;
@@ -1898,6 +1903,11 @@ type
          resources_used : boolean;
          program_name : ansistring;
          consume_semicolon_after_uses : boolean;
+         ps : tstaticvarsym;
+         paramnum : longint;
+         textsym : ttypesym;
+         sc : array of TProgramParam;
+         i : Longint;
       begin
          DLLsource:=islibrary;
          Status.IsLibrary:=IsLibrary;
@@ -1981,7 +1991,22 @@ type
               if token=_LKLAMMER then
                 begin
                    consume(_LKLAMMER);
+                   paramnum:=1;
                    repeat
+                     if m_iso in current_settings.modeswitches then
+                       begin
+                         if (pattern<>'INPUT') and (pattern<>'OUTPUT') then
+                           begin
+                             { the symtablestack is not setup here, so text must be created later on }
+                             Setlength(sc,length(sc)+1);
+                             with sc[high(sc)] do
+                               begin
+                                 name:=pattern;
+                                 nr:=paramnum;
+                               end;
+                             inc(paramnum);
+                           end;
+                       end;
                      consume(_ID);
                    until not try_to_consume(_COMMA);
                    consume(_RKLAMMER);
@@ -2001,8 +2026,8 @@ type
          current_module.in_interface:=false;
          current_module.interface_compiled:=true;
 
-         { insert after the unit symbol tables the static symbol table }
-         { of the program                                             }
+         { insert after the unit symbol tables the static symbol table
+           of the program                                              }
          current_module.localsymtable:=tstaticsymtable.create(current_module.modulename^,current_module.moduleid);
 
          { load standard units (system,objpas,profile unit) }
@@ -2011,7 +2036,22 @@ type
          { Load units provided on the command line }
          loadautounits;
 
-         {Load the units used by the program we compile.}
+         { insert iso program parameters }
+         if length(sc)>0 then
+           begin
+             textsym:=search_system_type('TEXT');
+             if not(assigned(textsym)) then
+               internalerror(2013011201);
+             for i:=0 to high(sc) do
+               begin
+                 ps:=tstaticvarsym.create(sc[i].name,vs_value,textsym.typedef,[]);
+                 ps.isoindex:=sc[i].nr;
+                 current_module.localsymtable.insert(ps,true);
+                 cnodeutils.insertbssdata(tstaticvarsym(ps));
+               end;
+           end;
+
+         { Load the units used by the program we compile. }
          if token=_USES then
            begin
              loadunits(nil);

compiler/symsym.pas

@@ -235,6 +235,10 @@ interface
 {$endif symansistr}
       public
           section : ansistring;
+          { if a text buffer has been defined as being initialized from command line
+            parameters as it is done by iso pascal with the program symbols,
+            isoindex contains the parameter number }
+          isoindex : dword;
           constructor create(const n : string;vsp:tvarspez;def:tdef;vopts:tvaroptions);
           constructor create_dll(const n : string;vsp:tvarspez;def:tdef);
           constructor create_C(const n: string; const mangled : TSymStr;vsp:tvarspez;def:tdef);

rtl/inc/compproc.inc

@@ -376,6 +376,8 @@ procedure fpc_PWideChar_To_ShortStr(out res : shortstring;const p : pwidechar);
 { from text.inc }
 Function fpc_get_input:PText;compilerproc;
 Function fpc_get_output:PText;compilerproc;
+Procedure fpc_textinit_iso(var t : Text;nr : DWord);compilerproc;
+Procedure fpc_textclose_iso(var t : Text);compilerproc;
 Procedure fpc_Write_End(var f:Text); compilerproc;
 Procedure fpc_Writeln_End(var f:Text); compilerproc;
 Procedure fpc_Write_Text_ShortStr(Len : Longint;var f : Text;const s : String); compilerproc;

rtl/inc/text.inc

@@ -615,6 +615,19 @@ begin
 end;
 
 
+Procedure fpc_textinit_iso(var t : Text;nr : DWord);compilerproc;
+begin
+  assign(t,paramstr(nr));
+  reset(t);
+end;
+
+
+Procedure fpc_textclose_iso(var t : Text);compilerproc;
+begin
+  close(t);
+end;
+
+
 {*****************************************************************************
                                Write(Ln)
 *****************************************************************************}