Browse Source

symcreat: support for scanner/parser escape sequences

Support escape sequences when parsing internally generated code. Used for now
to force interpreting certain identifiers as unit/namespace identifiers.
Jonas Maebe 2 years ago
parent
commit
b0e1867b4c
4 changed files with 70 additions and 20 deletions
  1. 13 8
      compiler/finput.pas
  2. 40 4
      compiler/scanner.pas
  3. 5 5
      compiler/symcreat.pas
  4. 12 3
      compiler/symtable.pas

+ 13 - 8
compiler/finput.pas

@@ -41,10 +41,6 @@ interface
          inc_path  : TPathStr;       { path if file was included with $I directive }
          inc_path  : TPathStr;       { path if file was included with $I directive }
          next      : tinputfile;    { next file for reading }
          next      : tinputfile;    { next file for reading }
 
 
-         is_macro,
-         endoffile,                 { still bytes left to read }
-         closed       : boolean;    { is the file closed }
-
          buf          : pchar;      { buffer }
          buf          : pchar;      { buffer }
          bufstart,                  { buffer start position in the file }
          bufstart,                  { buffer start position in the file }
          bufsize,                   { amount of bytes in the buffer }
          bufsize,                   { amount of bytes in the buffer }
@@ -60,6 +56,14 @@ interface
          ref_index  : longint;
          ref_index  : longint;
          ref_next   : tinputfile;
          ref_next   : tinputfile;
 
 
+         is_macro,
+         endoffile,                 { still bytes left to read }
+         closed       : boolean;    { is the file closed }
+
+         { this file represents an internally generated macro. Enables
+           certain escape sequences }
+         internally_generated_macro: boolean;
+
          constructor create(const fn:TPathStr);
          constructor create(const fn:TPathStr);
          destructor  destroy;override;
          destructor  destroy;override;
          procedure setpos(l:longint);
          procedure setpos(l:longint);
@@ -206,10 +210,6 @@ uses
         inc_path:='';
         inc_path:='';
         next:=nil;
         next:=nil;
         filetime:=-1;
         filetime:=-1;
-      { file info }
-        is_macro:=false;
-        endoffile:=false;
-        closed:=true;
         buf:=nil;
         buf:=nil;
         bufstart:=0;
         bufstart:=0;
         bufsize:=0;
         bufsize:=0;
@@ -224,6 +224,11 @@ uses
       { line buffer }
       { line buffer }
         linebuf:=nil;
         linebuf:=nil;
         maxlinebuf:=0;
         maxlinebuf:=0;
+      { file info }
+        is_macro:=false;
+        endoffile:=false;
+        closed:=true;
+        internally_generated_macro:=false;
       end;
       end;
 
 
 
 

+ 40 - 4
compiler/scanner.pas

@@ -37,6 +37,15 @@ interface
        max_macro_nesting=16;
        max_macro_nesting=16;
        preprocbufsize=32*1024;
        preprocbufsize=32*1024;
 
 
+       { when parsing an internally generated macro, if an identifier is
+         prefixed with this constant then it will always be interpreted as a
+         unit name (to avoid clashes with user-specified parameter or field
+         names duplicated in internally generated code) }
+       internal_macro_escape_unit_namespace_name = #1;
+
+       internal_macro_escape_begin = internal_macro_escape_unit_namespace_name;
+       internal_macro_escape_end = internal_macro_escape_unit_namespace_name;
+
 
 
     type
     type
        tcommentstyle = (comment_none,comment_tp,comment_oldtp,comment_delphi,comment_c);
        tcommentstyle = (comment_none,comment_tp,comment_oldtp,comment_delphi,comment_c);
@@ -168,7 +177,7 @@ interface
           procedure addfile(hp:tinputfile);
           procedure addfile(hp:tinputfile);
           procedure reload;
           procedure reload;
           { replaces current token with the text in p }
           { replaces current token with the text in p }
-          procedure substitutemacro(const macname:string;p:pchar;len,line,fileindex:longint);
+          procedure substitutemacro(const macname:string;p:pchar;len,line,fileindex:longint;internally_generated: boolean);
         { Scanner things }
         { Scanner things }
           procedure gettokenpos;
           procedure gettokenpos;
           procedure inc_comment_level;
           procedure inc_comment_level;
@@ -2645,7 +2654,7 @@ type
            if macroIsString then
            if macroIsString then
              hs:=''''+hs+'''';
              hs:=''''+hs+'''';
            current_scanner.substitutemacro(path,@hs[1],length(hs),
            current_scanner.substitutemacro(path,@hs[1],length(hs),
-             current_scanner.line_no,current_scanner.inputfile.ref_index);
+             current_scanner.line_no,current_scanner.inputfile.ref_index,false);
          end
          end
         else
         else
          begin
          begin
@@ -3713,7 +3722,7 @@ type
       end;
       end;
 
 
 
 
-    procedure tscannerfile.substitutemacro(const macname:string;p:pchar;len,line,fileindex:longint);
+    procedure tscannerfile.substitutemacro(const macname:string;p:pchar;len,line,fileindex:longint;internally_generated: boolean);
       var
       var
         hp : tinputfile;
         hp : tinputfile;
       begin
       begin
@@ -3733,6 +3742,7 @@ type
            inputpointer:=buf;
            inputpointer:=buf;
            inputstart:=bufstart;
            inputstart:=bufstart;
            ref_index:=fileindex;
            ref_index:=fileindex;
+           internally_generated_macro:=internally_generated;
          end;
          end;
       { reset line }
       { reset line }
         line_no:=line;
         line_no:=line;
@@ -4187,6 +4197,26 @@ type
               end;
               end;
             #0 :
             #0 :
               reload;
               reload;
+            else if inputfile.internally_generated_macro and
+                    (c in [internal_macro_escape_begin..internal_macro_escape_end]) then
+              begin
+                if i<255 then
+                 begin
+                   inc(i);
+                   orgpattern[i]:=c;
+                   pattern[i]:=c;
+                 end
+                else
+                 begin
+                   if not err then
+                     begin
+                       Message(scan_e_string_exceeds_255_chars);
+                       err:=true;
+                     end;
+                 end;
+                c:=inputpointer^;
+                inc(inputpointer);
+              end
             else
             else
               break;
               break;
           end;
           end;
@@ -4904,7 +4934,7 @@ type
                        mac.is_used:=true;
                        mac.is_used:=true;
                        inc(yylexcount);
                        inc(yylexcount);
                        substitutemacro(pattern,mac.buftext,mac.buflen,
                        substitutemacro(pattern,mac.buftext,mac.buflen,
-                         mac.fileinfo.line,mac.fileinfo.fileindex);
+                         mac.fileinfo.line,mac.fileinfo.fileindex,false);
                        { handle empty macros }
                        { handle empty macros }
                        if c=#0 then
                        if c=#0 then
                          begin
                          begin
@@ -5586,6 +5616,12 @@ type
                  checkpreprocstack;
                  checkpreprocstack;
                  goto exit_label;
                  goto exit_label;
                end;
                end;
+             else if inputfile.internally_generated_macro and
+                     (c in [internal_macro_escape_begin..internal_macro_escape_end]) then
+               begin
+                 token:=_ID;
+                 readstring;
+               end
              else
              else
                Illegal_Char(c);
                Illegal_Char(c);
            end;
            end;

+ 5 - 5
compiler/symcreat.pas

@@ -201,7 +201,7 @@ implementation
         current_scanner.closeinputfile;
         current_scanner.closeinputfile;
       { inject the string in the scanner }
       { inject the string in the scanner }
       str:=str+'end;';
       str:=str+'end;';
-      current_scanner.substitutemacro('meth_head_macro',@str[1],length(str),current_scanner.line_no,current_scanner.inputfile.ref_index);
+      current_scanner.substitutemacro('meth_head_macro',@str[1],length(str),current_scanner.line_no,current_scanner.inputfile.ref_index,true);
       current_scanner.readtoken(false);
       current_scanner.readtoken(false);
       { and parse it... }
       { and parse it... }
       case potype of
       case potype of
@@ -254,7 +254,7 @@ implementation
       { "const" starts a new kind of block and hence makes the scanner return }
       { "const" starts a new kind of block and hence makes the scanner return }
       str:=str+'const;';
       str:=str+'const;';
       { inject the string in the scanner }
       { inject the string in the scanner }
-      current_scanner.substitutemacro('meth_impl_macro',@str[1],length(str),lineno,fileno);
+      current_scanner.substitutemacro('meth_impl_macro',@str[1],length(str),lineno,fileno,true);
       current_scanner.readtoken(false);
       current_scanner.readtoken(false);
       { and parse it... }
       { and parse it... }
       flags:=[];
       flags:=[];
@@ -289,7 +289,7 @@ implementation
       old_block_type:=block_type;
       old_block_type:=block_type;
       parse_only:=true;
       parse_only:=true;
       block_type:=bt_const;
       block_type:=bt_const;
-      current_scanner.substitutemacro('typed_const_macro',@str[1],length(str),current_scanner.line_no,current_scanner.inputfile.ref_index);
+      current_scanner.substitutemacro('typed_const_macro',@str[1],length(str),current_scanner.line_no,current_scanner.inputfile.ref_index,true);
       current_scanner.readtoken(false);
       current_scanner.readtoken(false);
       read_typed_const(list,ssym,ssym.owner.symtabletype in [recordsymtable,objectsymtable]);
       read_typed_const(list,ssym,ssym.owner.symtabletype in [recordsymtable,objectsymtable]);
       parse_only:=old_parse_only;
       parse_only:=old_parse_only;
@@ -310,7 +310,7 @@ implementation
       if not assigned(def.owner.defowner) and
       if not assigned(def.owner.defowner) and
          assigned(def.owner.realname) and
          assigned(def.owner.realname) and
          (def.owner.moduleid<>0) then
          (def.owner.moduleid<>0) then
-        result:=def.owner.realname^+'.';
+        result:=internal_macro_escape_unit_namespace_name+def.owner.realname^+'.';
     end;
     end;
 
 
 
 
@@ -496,7 +496,7 @@ implementation
             begin
             begin
               fsym:=tfieldvarsym(sym);
               fsym:=tfieldvarsym(sym);
               if fsym.vardef.needs_inittable then
               if fsym.vardef.needs_inittable then
-                str:=str+'system.initialize(&'+fsym.realname+');';
+                str:=str+(internal_macro_escape_unit_namespace_name+'system.initialize(&')+fsym.realname+');';
             end;
             end;
         end;
         end;
       str:=str+'end;';
       str:=str+'end;';

+ 12 - 3
compiler/symtable.pas

@@ -311,7 +311,8 @@ interface
          ssf_search_option,
          ssf_search_option,
          ssf_search_helper,
          ssf_search_helper,
          ssf_has_inherited,
          ssf_has_inherited,
-         ssf_no_addsymref
+         ssf_no_addsymref,
+         ssf_unit_or_namespace_only
        );
        );
        tsymbol_search_flags = set of tsymbol_search_flag;
        tsymbol_search_flags = set of tsymbol_search_flag;
 
 
@@ -3402,7 +3403,12 @@ implementation
 
 
     function  searchsym(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
     function  searchsym(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
       begin
       begin
-        result:=searchsym_maybe_with_symoption(s,srsym,srsymtable,[],sp_none);
+        case s[1] of
+          internal_macro_escape_unit_namespace_name:
+            result:=searchsym_maybe_with_symoption(copy(s,2,length(s)-1),srsym,srsymtable,[ssf_unit_or_namespace_only],sp_none)
+          else
+            result:=searchsym_maybe_with_symoption(s,srsym,srsymtable,[],sp_none);
+        end
       end;
       end;
 
 
 
 
@@ -3424,7 +3430,8 @@ implementation
         while assigned(stackitem) do
         while assigned(stackitem) do
           begin
           begin
             srsymtable:=stackitem^.symtable;
             srsymtable:=stackitem^.symtable;
-            if (srsymtable.symtabletype=objectsymtable) then
+            if not(ssf_unit_or_namespace_only in flags) and
+               (srsymtable.symtabletype=objectsymtable) then
               begin
               begin
                 { TODO : implement the search for an option in classes as well }
                 { TODO : implement the search for an option in classes as well }
                 if ssf_search_option in flags then
                 if ssf_search_option in flags then
@@ -3446,6 +3453,8 @@ implementation
                   They are visible only if they are from the current unit or
                   They are visible only if they are from the current unit or
                   unit of generic of currently processed specialization. }
                   unit of generic of currently processed specialization. }
                 if assigned(srsym) and
                 if assigned(srsym) and
+                   (not(ssf_unit_or_namespace_only in flags) or
+                    (srsym.typ in [unitsym,namespacesym])) and
                    (
                    (
                      not(srsym.typ in [unitsym,namespacesym]) or
                      not(srsym.typ in [unitsym,namespacesym]) or
                      srsymtable.iscurrentunit or
                      srsymtable.iscurrentunit or