+ NEWINPUT for a better inputfile and scanner object

compiler/aasm.pas

@@ -310,9 +310,15 @@ uses
     constructor tai.init;
       begin
 {$ifdef GDB}
+  {$ifdef NEWINPUT}
+         infile:=pointer(current_module^.sourcefiles.get_file(aktfilepos.fileindex));
+         if assigned(infile) then
+           line:=aktfilepos.line;
+  {$else}
          infile:=pointer(current_module^.current_inputfile);
          if assigned(infile) then
            line:=current_module^.current_inputfile^.line_no;
+  {$endif}
 {$endif GDB}
       end;
 
@@ -837,7 +843,10 @@ uses
 end.
 {
   $Log$
-  Revision 1.10  1998-06-08 22:59:41  peter
+  Revision 1.11  1998-07-07 11:19:50  peter
+    + NEWINPUT for a better inputfile and scanner object
+
+  Revision 1.10  1998/06/08 22:59:41  peter
     * smartlinking works for win32
     * some defines to exclude some compiler parts
 

compiler/cgi386.pas

@@ -235,10 +235,15 @@ implementation
       begin
          oldcodegenerror:=codegenerror;
          oldswitches:=aktswitches;
+{$ifdef NEWINPUT}
+         oldpos:=aktfilepos;
+         aktfilepos:=p^.fileinfo;
+{$else}
          get_cur_file_pos(oldpos);
+         set_cur_file_pos(p^.fileinfo);
+{$endif NEWINPUT}
 
          codegenerror:=false;
-         set_cur_file_pos(p^.fileinfo);
          aktswitches:=p^.pragmas;
          if not(p^.error) then
            begin
@@ -249,7 +254,11 @@ implementation
          else
            codegenerror:=true;
          aktswitches:=oldswitches;
+{$ifdef NEWINPUT}
+         aktfilepos:=oldpos;
+{$else}
          set_cur_file_pos(oldpos);
+{$endif NEWINPUT}
       end;
 
 
@@ -331,8 +340,10 @@ implementation
 
       begin
          cleartempgen;
+{$ifndef NEWINPUT}
          oldis:=current_module^.current_inputfile;
          oldnr:=current_module^.current_inputfile^.line_no;
+{$endif}
          { when size optimization only count occurrence }
          if cs_littlesize in aktswitches then
            t_times:=1
@@ -398,19 +409,18 @@ implementation
                         for i:=1 to maxvarregs do
                           regvars[i]:=nil;
                         parasym:=false;
-{$ifdef tp}
+                      {$ifdef tp}
                         symtablestack^.foreach(searchregvars);
-{$else}
+                      {$else}
                         symtablestack^.foreach(@searchregvars);
-{$endif}
+                      {$endif}
                         { copy parameter into a register ? }
                         parasym:=true;
-{$ifdef tp}
+                      {$ifdef tp}
                         symtablestack^.next^.foreach(searchregvars);
-{$else}
+                      {$else}
                         symtablestack^.next^.foreach(@searchregvars);
-{$endif}
-
+                      {$endif}
                         { hold needed registers free }
                         for i:=maxvarregs downto maxvarregs-p^.registers32+1 do
                           regvars[i]:=nil;
@@ -504,14 +514,19 @@ implementation
            end;
          procinfo.aktproccode^.concatlist(exprasmlist);
          make_const_global:=false;
+{$ifndef NEWINPUT}
          current_module^.current_inputfile:=oldis;
          current_module^.current_inputfile^.line_no:=oldnr;
+{$endif}
       end;
 
 end.
 {
   $Log$
-  Revision 1.39  1998-06-12 10:32:23  pierre
+  Revision 1.40  1998-07-07 11:19:52  peter
+    + NEWINPUT for a better inputfile and scanner object
+
+  Revision 1.39  1998/06/12 10:32:23  pierre
     * column problem hopefully solved
     + C vars declaration changed
 

compiler/cobjects.pas

@@ -43,15 +43,15 @@ unit cobjects;
     type
        pstring = ^string;
 
+       pfileposinfo = ^tfileposinfo;
        tfileposinfo = record
-         line : longint; { could be changed to abspos }
-         fileindex,column : word;
+         line      : longint;
+         column    : word;
+         fileindex : word;
        end;
-       pfileposinfo = ^tfileposinfo;
 
        { some help data types }
        pstringitem = ^tstringitem;
-
        tstringitem = record
           data : pstring;
           next : pstringitem;
@@ -59,7 +59,6 @@ unit cobjects;
        end;
 
        plinkedlist_item = ^tlinkedlist_item;
-
        tlinkedlist_item = object
           next,previous : plinkedlist_item;
           { does nothing }
@@ -68,16 +67,14 @@ unit cobjects;
        end;
 
        pstring_item = ^tstring_item;
-
        tstring_item = object(tlinkedlist_item)
           str : pstring;
           constructor init(const s : string);
           destructor done;virtual;
        end;
 
-       plinkedlist = ^tlinkedlist;
-
        { this implements a double linked list }
+       plinkedlist = ^tlinkedlist;
        tlinkedlist = object
           first,last : plinkedlist_item;
           constructor init;
@@ -146,6 +143,8 @@ unit cobjects;
           procedure clear;
        end;
 
+{$ifndef NEWINPUT}
+
        pbufferedfile = ^tbufferedfile;
 
        { this is implemented to allow buffered binary I/O }
@@ -238,6 +237,8 @@ unit cobjects;
            function getcrc : longint;
        end;
 
+{$endif NEWINPUT}
+
     { releases the string p and assignes nil to p }
     { if p=nil then freemem isn't called          }
     procedure stringdispose(var p : pstring);
@@ -737,6 +738,7 @@ end;
       end;
 
 
+{$ifndef NEWINPUT}
 
 {****************************************************************************
                                TBUFFEREDFILE
@@ -1119,10 +1121,15 @@ end;
            end;
       end;
 
+{$endif NEWINPUT}
+
 end.
 {
   $Log$
-  Revision 1.10  1998-07-01 15:26:59  peter
+  Revision 1.11  1998-07-07 11:19:54  peter
+    + NEWINPUT for a better inputfile and scanner object
+
+  Revision 1.10  1998/07/01 15:26:59  peter
     * better bufferfile.reset error handling
 
   Revision 1.9  1998/06/03 23:40:37  peter

compiler/files.pas

@@ -38,14 +38,46 @@ unit files;
        extbufsize = 65535;
 {$else}
        maxunits = 128;
-       {$ifndef msdos}
-       extbufsize = 2000;
-       {$else}
-       extbufsize=512;
-       {$endif dpmi}
+       extbufsize=1024;
 {$endif}
 
     type
+{$ifdef NEWINPUT}
+       pinputfile = ^tinputfile;
+       tinputfile = object
+          path,name    : pstring;    { path and filename }
+          next         : pinputfile; { next file for reading }
+
+          savebufstart,              { save fields for scanner }
+          savebufsize,
+          savelastlinepos,
+          saveline_no      : longint;
+          saveinputbuffer,
+          saveinputpointer : pchar;
+
+          ref_count    : longint;    { to handle the browser refs }
+          ref_index    : longint;
+          ref_next     : pinputfile;
+
+          constructor init(const fn:string);
+          destructor done;
+       end;
+
+       pfilemanager = ^tfilemanager;
+       tfilemanager = object
+          files : pinputfile;
+          last_ref_index : longint;
+          constructor init;
+          destructor done;
+          procedure register_file(f : pinputfile);
+          function  get_file(l:longint) : pinputfile;
+          function  get_file_name(l :longint):string;
+          function  get_file_path(l :longint):string;
+       end;
+
+
+{$else NEWINPUT}
+
        { this isn't a text file, this is t-ext-file }
        { which means a extended file this files can }
        { be handled by a file manager               }
@@ -83,6 +115,8 @@ unit files;
           function  get_file(w : word) : pextfile;
        end;
 
+{$endif NEWINPUT}
+
     type
        tunitmap = array[0..maxunits-1] of pointer;
        punitmap = ^tunitmap;
@@ -118,7 +152,9 @@ unit files;
           linkstaticlibs,
           linkofiles    : tstringcontainer;
           used_units    : tlinkedlist;
+{$ifndef NEWINPUT}
           current_inputfile : pinputfile;
+{$endif}
           { used in firstpass for faster settings }
           current_index : word;
 
@@ -136,7 +172,7 @@ unit files;
 {$else}
           destructor special_done;virtual; { this is to be called only when compiling again }
 {$endif OLDPPU}
-          procedure setfilename(const _path,name:string);
+          procedure setfilename(const fn:string);
 {$ifndef OLDPPU}
           function  openppu:boolean;
 {$else}
@@ -253,6 +289,103 @@ unit files;
   uses
     dos,verbose,systems;
 
+{$ifdef NEWINPUT}
+
+{****************************************************************************
+                                  TINPUTFILE
+ ****************************************************************************}
+
+    constructor tinputfile.init(const fn:string);
+      var
+        p,n,e : string;
+      begin
+        FSplit(fn,p,n,e);
+        name:=stringdup(n+e);
+        path:=stringdup(p);
+        next:=nil;
+        ref_next:=nil;
+        ref_count:=0;
+        ref_index:=0;
+      end;
+
+
+    destructor tinputfile.done;
+      begin
+        stringdispose(path);
+        stringdispose(name);
+      end;
+
+
+{****************************************************************************
+                                TFILEMANAGER
+ ****************************************************************************}
+
+    constructor tfilemanager.init;
+      begin
+         files:=nil;
+         last_ref_index:=0;
+      end;
+
+
+    destructor tfilemanager.done;
+      var
+         hp : pinputfile;
+      begin
+         hp:=files;
+         while assigned(hp) do
+          begin
+            files:=files^.ref_next;
+            dispose(hp,done);
+            hp:=files;
+          end;
+         last_ref_index:=0;
+      end;
+
+
+    procedure tfilemanager.register_file(f : pinputfile);
+      begin
+         inc(last_ref_index);
+         f^.ref_next:=files;
+         f^.ref_index:=last_ref_index;
+         files:=f;
+      end;
+
+
+   function tfilemanager.get_file(l :longint) : pinputfile;
+     var
+        ff : pinputfile;
+     begin
+        ff:=files;
+        while assigned(ff) and (ff^.ref_index<>l) do
+         ff:=ff^.ref_next;
+        get_file:=ff;
+     end;
+
+
+   function tfilemanager.get_file_name(l :longint):string;
+     var
+       hp : pinputfile;
+     begin
+       hp:=get_file(l);
+       if assigned(hp) then
+        get_file_name:=hp^.name^
+       else
+        get_file_name:='';
+     end;
+
+
+   function tfilemanager.get_file_path(l :longint):string;
+     var
+       hp : pinputfile;
+     begin
+       hp:=get_file(l);
+       if assigned(hp) then
+        get_file_path:=hp^.path^
+       else
+        get_file_path:='';
+     end;
+
+{$else NEWINPUT}
 
 {****************************************************************************
                                   TFILE
@@ -359,22 +492,24 @@ unit files;
         get_file:=ff;
      end;
 
+{$endif NEWINPUT}
 
 {****************************************************************************
                                   TMODULE
  ****************************************************************************}
 
-    procedure tmodule.setfilename(const _path,name:string);
+    procedure tmodule.setfilename(const fn:string);
       var
-        s : string;
+        p,n,e,s : string;
       begin
+         fsplit(fn,p,n,e);
          stringdispose(objfilename);
          stringdispose(asmfilename);
          stringdispose(ppufilename);
          stringdispose(libfilename);
          stringdispose(path);
-         path:=stringdup(FixPath(_path));
-         s:=FixFileName(FixPath(_path)+name);
+         path:=stringdup(FixPath(p));
+         s:=FixFileName(FixPath(p)+n);
          objfilename:=stringdup(s+target_info.objext);
          asmfilename:=stringdup(s+target_info.asmext);
          ppufilename:=stringdup(s+target_info.unitext);
@@ -508,7 +643,7 @@ unit files;
               Found:=UnitExists(target_info.unitlibext);
               if Found then
                Begin
-                 SetFileName(SinglePathString,FileName);
+                 SetFileName(SinglePathString+FileName);
                  Found:=OpenPPU;
                End;
              end;
@@ -518,7 +653,7 @@ unit files;
               Found:=UnitExists(target_info.unitext);
               if Found then
                Begin
-                 SetFileName(SinglePathString,FileName);
+                 SetFileName(SinglePathString+FileName);
                  Found:=OpenPPU;
                End;
             end;
@@ -544,7 +679,7 @@ unit files;
                  sources_avail:=true;
                {Load Filenames when found}
                  mainsource:=StringDup(SinglePathString+FileName+Ext);
-                 SetFileName(SinglePathString,FileName);
+                 SetFileName(SinglePathString+FileName);
                end
               else
                sources_avail:=false;
@@ -826,14 +961,16 @@ unit files;
          libfilename:=nil;
          ppufilename:=nil;
          path:=nil;
-         setfilename(p,n);
+         setfilename(p+n);
          used_units.init;
          sourcefiles.init;
          linkofiles.init;
          linkstaticlibs.init;
          linksharedlibs.init;
          ppufile:=nil;
+{$ifndef NEWINPUT}
          current_inputfile:=nil;
+{$endif}
          map:=nil;
          symtable:=nil;
          flags:=0;
@@ -968,7 +1105,10 @@ unit files;
 end.
 {
   $Log$
-  Revision 1.29  1998-06-25 10:51:00  pierre
+  Revision 1.30  1998-07-07 11:19:55  peter
+    + NEWINPUT for a better inputfile and scanner object
+
+  Revision 1.29  1998/06/25 10:51:00  pierre
     * removed a remaining ifndef NEWPPU
       replaced by ifdef OLDPPU
     * added uf_finalize to ppu unit

compiler/parser.pas

@@ -54,11 +54,6 @@ unit parser;
          { and no function header                        }
          testcurobject:=0;
 
-         { create error defintion }
-         generrordef:=new(perrordef,init);
-
-         symtablestack:=nil;
-
          { a long time, this was forgotten }
          aktprocsym:=nil;
 
@@ -104,8 +99,14 @@ unit parser;
          oldpreprocstack : ppreprocstack;
          oldorgpattern,oldprocprefix : string;
          old_block_type : tblock_type;
+{$ifdef NEWINPUT}
+         oldcurrent_scanner : pscannerfile;
+         oldaktfilepos : tfileposinfo;
+         oldlastlinepos : longint;
+{$else}
          oldcurrlinepos,
          oldlastlinepos,
+{$endif NEWINPUT}
          oldinputbuffer,
          oldinputpointer : pchar;
          olds_point,oldparse_only : boolean;
@@ -158,21 +159,26 @@ unit parser;
           end;
 
          { save scanner state }
-         oldmacros:=macros;
-         oldpattern:=pattern;
-         oldtoken:=token;
-         oldtokenpos:=tokenpos;
-         oldorgpattern:=orgpattern;
-         old_block_type:=block_type;
+{$ifdef NEWINPUT}
+         oldaktfilepos:=aktfilepos;
+         oldcurrent_scanner:=current_scanner;
+{$else}
+         oldcurrlinepos:=currlinepos;
          oldpreprocstack:=preprocstack;
-
          oldinputbuffer:=inputbuffer;
          oldinputpointer:=inputpointer;
-         oldcurrlinepos:=currlinepos;
          oldlastlinepos:=lastlinepos;
          olds_point:=s_point;
-         oldc:=c;
          oldcomment_level:=comment_level;
+{$endif}
+         oldc:=c;
+         oldpattern:=pattern;
+         oldtoken:=token;
+         oldtokenpos:=tokenpos;
+         oldorgpattern:=orgpattern;
+         old_block_type:=block_type;
+
+         oldmacros:=macros;
 
          oldnextlabelnr:=nextlabelnr;
          oldparse_only:=parse_only;
@@ -198,10 +204,6 @@ unit parser;
          oldoptprocessor:=aktoptprocessor;
          oldasmmode:=aktasmmode;
 
-         Message1(parser_i_compiling,filename);
-
-         InitScanner(filename);
-
        { Load current state from the init values }
          aktswitches:=initswitches;
          aktpackrecords:=initpackrecords;
@@ -219,15 +221,24 @@ unit parser;
          default_macros;
 
        { startup scanner }
+{$ifdef NEWINPUT}
+         current_scanner:=new(pscannerfile,Init(filename));
+         token:=current_scanner^.yylex;
+{$else}
+         InitScanner(filename);
          token:=yylex;
+{$endif}
+
+         Message1(parser_i_compiling,filename);
+
+       { global switches are read, so further changes aren't allowed }
+         current_module^.in_main:=true;
 
        { init code generator for a new module }
          codegen_newmodule;
 {$ifdef GDB}
          reset_gdb_info;
 {$endif GDB}
-       { global switches are read, so further changes aren't allowed }
-         current_module^.in_main:=true;
 
        { Handle things which need to be once }
          if (compile_level=1) then
@@ -313,14 +324,12 @@ done:
 {$ifdef GDB}
          reset_gdb_info;
 {$endif GDB}
+
          { restore symtable state }
-{$ifdef UseBrowser}
          if (compile_level>1) then
-{ we want to keep the current symtablestack }
-{$endif UseBrowser}
            begin
-              refsymtable:=oldrefsymtable;
-              symtablestack:=oldsymtablestack;
+             refsymtable:=oldrefsymtable;
+             symtablestack:=oldsymtablestack;
            end;
 
          procprefix:=oldprocprefix;
@@ -340,33 +349,42 @@ done:
               dispose(current_module^.ppufile,done);
               current_module^.ppufile:=nil;
            end;
-         { restore scanner state }
-         pattern:=oldpattern;
-         token:=oldtoken;
-         tokenpos:=oldtokenpos;
-         orgpattern:=oldorgpattern;
-         block_type:=old_block_type;
 
          { call donescanner before restoring preprocstack, because }
          { donescanner tests for a empty preprocstack              }
          { and can also check for unused macros                    }
+{$ifdef NEWINPUT}
+         dispose(current_scanner,done);
+{$else}
          donescanner(current_module^.compiled);
+{$endif}
          dispose(macros,done);
-         macros:=oldmacros;
 
          { restore scanner }
+{$ifdef NEWINPUT}
+         aktfilepos:=oldaktfilepos;
+         current_scanner:=oldcurrent_scanner;
+{$else}
          preprocstack:=oldpreprocstack;
          inputbuffer:=oldinputbuffer;
          inputpointer:=oldinputpointer;
          lastlinepos:=oldlastlinepos;
          currlinepos:=oldcurrlinepos;
          s_point:=olds_point;
-         c:=oldc;
          comment_level:=oldcomment_level;
+{$endif}
+         c:=oldc;
+         pattern:=oldpattern;
+         token:=oldtoken;
+         tokenpos:=oldtokenpos;
+         orgpattern:=oldorgpattern;
+         block_type:=old_block_type;
 
          nextlabelnr:=oldnextlabelnr;
          parse_only:=oldparse_only;
 
+         macros:=oldmacros;
+
          { restore asmlists }
          exprasmlist:=oldexprasmlist;
          datasegment:=olddatasegment;
@@ -414,7 +432,10 @@ done:
 end.
 {
   $Log$
-  Revision 1.28  1998-06-25 11:15:33  pierre
+  Revision 1.29  1998-07-07 11:19:59  peter
+    + NEWINPUT for a better inputfile and scanner object
+
+  Revision 1.28  1998/06/25 11:15:33  pierre
     * ppu files where not closed in newppu !!
       second compilation was impossible due to too many opened files
       (not visible in 'make cycle' as we remove all the ppu files)

compiler/pass_1.pas

@@ -1825,7 +1825,8 @@ unit pass_1;
 
          if (p^.left^.resulttype^.deftype=stringdef) and (assigned(p^.right^.resulttype)) then
           begin
-            if not (p^.right^.resulttype^.deftype in [stringdef,orddef]) then
+            if not ((p^.right^.resulttype^.deftype=stringdef) or
+                    ((p^.right^.resulttype^.deftype=orddef) {and (porddef(p^.right^.resulttype)^.typ=uchar)})) then
              begin
                p^.right:=gentypeconvnode(p^.right,p^.left^.resulttype);
                firstpass(p^.right);
@@ -3724,7 +3725,7 @@ unit pass_1;
                       { check type }
                       if (p^.left^.resulttype^.deftype in [enumdef,pointerdef]) or
                          ((p^.left^.resulttype^.deftype=orddef) and
-                          (porddef(p^.left^.resulttype)^.typ in [bool8bit,u8bit,s8bit,
+                          (porddef(p^.left^.resulttype)^.typ in [uchar,bool8bit,u8bit,s8bit,
                              bool16bit,u16bit,s16bit,bool32bit,u32bit,s32bit])) then
                         begin
                            { two paras ? }
@@ -4296,13 +4297,20 @@ unit pass_1;
                      (hp^.left^.treetype<>labeln) then
                      begin
                         { use correct line number }
+{$ifdef NEWINPUT}
+                        aktfilepos:=hp^.left^.fileinfo;
+{$else}
                         set_current_file_line(hp^.left);
+{$endif}
                         disposetree(hp^.left);
                         hp^.left:=nil;
                         Message(cg_w_unreachable_code);
-
                         { old lines }
-                        set_current_file_line(hp^.right);
+{$ifdef NEWINPUT}
+                        aktfilepos:=hp^.right^.fileinfo;
+{$else}
+                        set_current_file_line(hp^.left);
+{$endif}
                      end;
                 end;
               if assigned(hp^.right) then
@@ -4974,7 +4982,11 @@ unit pass_1;
 {$endif extdebug}
          { if we save there the whole stuff, }
          { line numbers become more correct  }
+{$ifdef NEWINPUT}
+         oldpos:=aktfilepos;
+{$else}
          get_cur_file_pos(oldpos);
+{$endif NEWINPUT}
          oldcodegenerror:=codegenerror;
          oldswitches:=aktswitches;
 {$ifdef extdebug}
@@ -4991,7 +5003,11 @@ unit pass_1;
 {$endif extdebug}
 
          codegenerror:=false;
+{$ifdef NEWINPUT}
+         aktfilepos:=p^.fileinfo;
+{$else}
          set_cur_file_pos(p^.fileinfo);
+{$endif NEWINPUT}
          aktswitches:=p^.pragmas;
 
          if not(p^.error) then
@@ -5019,7 +5035,11 @@ unit pass_1;
            inc(p^.firstpasscount);
 {$endif extdebug}
          aktswitches:=oldswitches;
+{$ifdef NEWINPUT}
+         aktfilepos:=oldpos;
+{$else}
          set_cur_file_pos(oldpos);
+{$endif NEWINPUT}
       end;
 
     function do_firstpass(var p : ptree) : boolean;
@@ -5044,7 +5064,10 @@ unit pass_1;
 end.
 {
   $Log$
-  Revision 1.35  1998-06-25 14:04:19  peter
+  Revision 1.36  1998-07-07 11:20:00  peter
+    + NEWINPUT for a better inputfile and scanner object
+
+  Revision 1.35  1998/06/25 14:04:19  peter
     + internal inc/dec
 
   Revision 1.34  1998/06/25 08:48:14  florian

compiler/pbase.pas

@@ -69,7 +69,7 @@ unit pbase;
     procedure consume(i : ttoken);
 
     function tokenstring(i : ttoken) : string;
-    
+
     { consumes all tokens til atoken (for error recovering }
     procedure consume_all_until(atoken : ttoken);
 
@@ -97,7 +97,11 @@ unit pbase;
       procedure syntaxerror(s : string);
 
         begin
+{$ifdef NEWINPUT}
+           Message2(scan_f_syn_expected,tostr(aktfilepos.column),s);
+{$else}
            Message2(scan_f_syn_expected,tostr(get_current_col),s);
+{$endif}
         end;
 
       { This is changed since I changed the order of token
@@ -151,7 +155,7 @@ unit pbase;
            begin
              if token=_END then
                 last_endtoken_filepos:=tokenpos;
-             token:=yylex;
+             token:={$ifdef NEWINPUT}current_scanner^.{$endif}yylex;
            end;
       end;
 
@@ -225,7 +229,10 @@ end.
 
 {
   $Log$
-  Revision 1.10  1998-06-05 14:37:31  pierre
+  Revision 1.11  1998-07-07 11:20:02  peter
+    + NEWINPUT for a better inputfile and scanner object
+
+  Revision 1.10  1998/06/05 14:37:31  pierre
     * fixes for inline for operators
     * inline procedure more correctly restricted
 

compiler/pmodules.pas

@@ -254,11 +254,18 @@ unit pmodules;
               Message1(unit_f_cant_compile_unit,current_module^.modulename^)
              else
               begin
+{$ifdef NEWINPUT}
+                current_scanner^.close;
+                compile(current_module^.mainsource^,compile_system);
+                if (not old_current_module^.compiled) then
+                 current_scanner^.reopen;
+{$else}
                 if assigned(old_current_module^.current_inputfile) then
                  old_current_module^.current_inputfile^.tempclose;
                 compile(current_module^.mainsource^,compile_system);
                 if (not old_current_module^.compiled) and assigned(old_current_module^.current_inputfile) then
                  old_current_module^.current_inputfile^.tempreopen;
+{$endif}
               end;
            end
           else
@@ -743,10 +750,11 @@ unit pmodules;
 
       var
          { unitname : stringid; }
-         names:Tstringcontainer;
-         p : psymtable;
+         names  : Tstringcontainer;
+         p      : psymtable;
          unitst : punitsymtable;
          pu     : pused_unit;
+         i      : longint;
          s1,s2  : ^string; {Saves stack space}
       begin
          consume(_UNIT);
@@ -754,15 +762,26 @@ unit pmodules;
          if token=ID then
           begin
           { create filenames and unit name }
-             current_module^.SetFileName(current_module^.current_inputfile^.path^,current_module^.current_inputfile^.name^);
+{$ifdef NEWINPUT}
+             current_module^.SetFileName(current_scanner^.inputfile^.path^+current_scanner^.inputfile^.name^);
+{$else}
+             current_module^.SetFileName(current_module^.current_inputfile^.path^+current_module^.current_inputfile^.name^);
+{$endif}
              stringdispose(current_module^.modulename);
              current_module^.modulename:=stringdup(upper(pattern));
-
           { check for system unit }
              new(s1);
              new(s2);
              s1^:=upper(target_info.system_unit);
+{$ifdef NEWINPUT}
+             s2^:=upper(current_scanner^.inputfile^.name^);
+             { strip extension, there could only be one dot }
+             i:=pos('.',s2^);
+             if i>0 then
+              s2^:=Copy(s2^,1,i-1);
+{$else}
              s2^:=upper(current_module^.current_inputfile^.name^);
+{$endif}
              if (cs_compilesystem in aktswitches)  then
               begin
                 if (cs_check_unit_name in aktswitches) and
@@ -788,6 +807,9 @@ unit pmodules;
          consume(SEMICOLON);
          consume(_INTERFACE);
 
+         { update status }
+         status.currentmodule:=current_module^.modulename^;
+
          { this should be placed after uses !!}
 {$ifndef UseNiceNames}
          procprefix:='_'+current_module^.modulename^+'$$';
@@ -1155,7 +1177,10 @@ unit pmodules;
 end.
 {
   $Log$
-  Revision 1.33  1998-06-25 11:15:34  pierre
+  Revision 1.34  1998-07-07 11:20:03  peter
+    + NEWINPUT for a better inputfile and scanner object
+
+  Revision 1.33  1998/06/25 11:15:34  pierre
     * ppu files where not closed in newppu !!
       second compilation was impossible due to too many opened files
       (not visible in 'make cycle' as we remove all the ppu files)

compiler/pp.pas

@@ -246,8 +246,12 @@ begin
             end;
      end;
    {when the module is assigned, then the messagefile is also loaded}
+{$ifdef NEWINPUT}
+     Writeln('Compilation aborted at line ',aktfilepos.line);
+{$else}
      if assigned(current_module) and assigned(current_module^.current_inputfile) then
       Writeln('Compilation aborted at line ',current_module^.current_inputfile^.line_no);
+{$endif}
    end;
 end;
 
@@ -394,7 +398,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.18  1998-06-24 14:06:33  peter
+  Revision 1.19  1998-07-07 11:20:04  peter
+    + NEWINPUT for a better inputfile and scanner object
+
+  Revision 1.18  1998/06/24 14:06:33  peter
     * fixed the name changes
 
   Revision 1.17  1998/06/23 08:59:22  daniel

compiler/ra386att.pas

@@ -324,12 +324,10 @@ const
     token := AS_NONE;
     { while space and tab , continue scan... }
     while c in [' ',#9] do
-     c:=asmgetchar;
+     c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
     { Possiblities for first token in a statement:                }
     {   Local Label, Label, Directive, Prefix or Opcode....       }
-    tokenpos.line:=current_module^.current_inputfile^.line_no;
-    tokenpos.column:=get_file_col;
-    tokenpos.fileindex:=current_module^.current_index;
+    {$ifdef NEWINPUT}current_scanner^.{$endif}gettokenpos;
     if firsttoken and not (c in [newline,#13,'{',';']) then
     begin
       firsttoken := FALSE;
@@ -338,11 +336,11 @@ const
       begin
         actasmpattern := c;
         { Let us point to the next character }
-        c := asmgetchar;
+        c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
         while c in ['A'..'Z','a'..'z','0'..'9','_','$'] do
         begin
          actasmpattern := actasmpattern + c;
-         c := asmgetchar;
+         c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
         end;
 
         { this is a local label... }
@@ -353,7 +351,7 @@ const
           { delete .L }
           delete(actasmpattern,1,2);
           { point to next character ... }
-          c := asmgetchar;
+          c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
           exit;
         end
         { must be a directive }
@@ -371,7 +369,7 @@ const
         end;
       end; { endif }
 
-
+{$ifndef NEWINPUT}
       if c='/' then
         begin
            c:=asmgetchar;
@@ -389,11 +387,13 @@ const
            else
              Message(assem_e_slash_at_begin_of_line_not_allowed);
         end;
+{$endif}
+
       { only opcodes and global labels are allowed now. }
       while c in ['A'..'Z','a'..'z','0'..'9','_'] do
       begin
          actasmpattern := actasmpattern + c;
-         c := asmgetchar;
+         c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
       end;
 
       if c = ':' then
@@ -405,7 +405,7 @@ const
            for labels !! (PM) }
            token := AS_LABEL;
            { let us point to the next character }
-           c := asmgetchar;
+           c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
            gettoken := token;
            exit;
       end;
@@ -438,11 +438,11 @@ const
                 {                - directive.                                     }
                             begin
                              actasmpattern := c;
-                             c:= asmgetchar;
+                             c:= {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                              while c in  ['A'..'Z','a'..'z','0'..'9','_','$'] do
                              begin
                                actasmpattern := actasmpattern + c;
-                               c := asmgetchar;
+                               c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                              end;
                              is_asmdirective(actasmpattern,token);
                              { if directive }
@@ -459,11 +459,11 @@ const
       { identifier, register, opcode, prefix or directive }
          '_','A'..'Z','a'..'z': begin
                              actasmpattern := c;
-                             c:= asmgetchar;
+                             c:= {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                              while c in  ['A'..'Z','a'..'z','0'..'9','_','$'] do
                              begin
                                actasmpattern := actasmpattern + c;
-                               c := asmgetchar;
+                               c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                              end;
                              { pascal is not case sensitive!    }
                              { therefore variables which are    }
@@ -498,16 +498,16 @@ const
                              exit;
                           end;
            '&':       begin
-                         c:=asmgetchar;
+                         c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                          gettoken := AS_AND;
                       end;
            { character }
            '''' :     begin
-                         c:=asmgetchar;
+                         c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                          if c = '\' then
                          Begin
                            { escape sequence }
-                           c:=asmgetchar;
+                           c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                            case c of
                          newline: Message(scan_f_string_exceeds_line);
                              't': actasmpattern:=#09;
@@ -521,8 +521,8 @@ const
                              '0'..'7':
                                 begin
                                    temp:=c;
-                                   temp:=temp+asmgetchar;
-                                   temp:=temp+asmgetchar;
+                                   temp:=temp+{$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
+                                   temp:=temp+{$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                                    val(octaltodec(temp),value,code);
                                    if (code <> 0) then
                                     Message1(assem_e_error_in_octal_const,temp);
@@ -531,8 +531,8 @@ const
                              { hexadecimal number }
                              'x':
                                  begin
-                                   temp:=asmgetchar;
-                                   temp:=temp+asmgetchar;
+                                   temp:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
+                                   temp:=temp+{$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                                    val(hextodec(temp),value,code);
                                    if (code <> 0) then
                                     Message1(assem_e_error_in_hex_const,temp);
@@ -549,7 +549,7 @@ const
                            actasmpattern:=c;
 
                          gettoken := AS_STRING;
-                         c:=asmgetchar;
+                         c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                          exit;
 
                       end;
@@ -559,11 +559,11 @@ const
                          actasmpattern:='';
                          while true do
                          Begin
-                           c:=asmgetchar;
+                           c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                            case c of
                             '\': Begin
                                   { escape sequences }
-                                  c:=asmgetchar;
+                                  c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                                   case c of
                                    newline: Message(scan_f_string_exceeds_line);
                                    't': actasmpattern:=actasmpattern+#09;
@@ -577,8 +577,8 @@ const
                                    '0'..'7':
                                       begin
                                            temp:=c;
-                                           temp:=temp+asmgetchar;
-                                           temp:=temp+asmgetchar;
+                                           temp:=temp+{$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
+                                           temp:=temp+{$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                                            val(octaltodec(temp),value,code);
                                            if (code <> 0) then
                                             Message1(assem_e_error_in_octal_const,temp);
@@ -587,8 +587,8 @@ const
                                    { hexadecimal number }
                                    'x':
                                      begin
-                                       temp:=asmgetchar;
-                                       temp:=temp+asmgetchar;
+                                       temp:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
+                                       temp:=temp+{$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                                        val(hextodec(temp),value,code);
                                        if (code <> 0) then
                                         Message1(assem_e_error_in_hex_const,temp);
@@ -602,7 +602,7 @@ const
                                    end; { end case }
                                  end;
                             '"': begin
-                                  c:=asmgetchar;
+                                  c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                                   break;
                                  end;
                             newline: Message(scan_f_string_exceeds_line);
@@ -616,91 +616,91 @@ const
                  end;
            '$' :  begin
                    gettoken := AS_DOLLAR;
-                   c:=asmgetchar;
+                   c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    exit;
                   end;
            ',' : begin
                    gettoken := AS_COMMA;
-                   c:=asmgetchar;
+                   c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    exit;
                  end;
            '<' : begin
                    gettoken := AS_SHL;
-                   c := asmgetchar;
+                   c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    if c = '<' then
-                     c := asmgetchar;
+                     c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    exit;
                  end;
            '>' : begin
                    gettoken := AS_SHL;
-                   c := asmgetchar;
+                   c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    if c = '>' then
-                     c := asmgetchar;
+                     c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    exit;
                  end;
            '|' : begin
                    gettoken := AS_OR;
-                   c := asmgetchar;
+                   c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    exit;
                  end;
            '^' : begin
                   gettoken := AS_XOR;
-                  c := asmgetchar;
+                  c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                   exit;
                  end;
            '!' : begin
                   Message(assem_e_nor_not_supported);
-                  c := asmgetchar;
+                  c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                   gettoken := AS_NONE;
                   exit;
                  end;
            '(' : begin
                    gettoken := AS_LPAREN;
-                   c:=asmgetchar;
+                   c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    exit;
                  end;
            ')' : begin
                    gettoken := AS_RPAREN;
-                   c:=asmgetchar;
+                   c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    exit;
                  end;
            ':' : begin
                    gettoken := AS_COLON;
-                   c:=asmgetchar;
+                   c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    exit;
                  end;
            '+' : begin
                    gettoken := AS_PLUS;
-                   c:=asmgetchar;
+                   c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    exit;
                  end;
            '-' : begin
                    gettoken := AS_MINUS;
-                   c:=asmgetchar;
+                   c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    exit;
                  end;
            '*' : begin
                    gettoken := AS_STAR;
-                   c:=asmgetchar;
+                   c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    exit;
                  end;
            '/' : begin
-                   c:=asmgetchar;
+                   c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    { att styled comment }
                    if c='/' then
                      begin
                         repeat
-                           c:=asmgetchar;
+                           c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                         until c=newline;
                         firsttoken := TRUE;
                         gettoken:=AS_SEPARATOR;
-                        c:=asmgetchar;
+                        c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                         exit;
                      end
                    else
                      begin
                         gettoken := AS_SLASH;
-                        c:=asmgetchar;
+                        c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                         exit;
                      end;
                  end;
@@ -709,29 +709,29 @@ const
            { for the moment.         }
            '%' : begin
                      actasmpattern := c;
-                     c:=asmgetchar;
+                     c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                      while c in ['a'..'z','A'..'Z','0'..'9'] do
                      Begin
                         actasmpattern := actasmpattern + c;
-                        c:=asmgetchar;
+                        c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                      end;
                      token := AS_NONE;
                      uppervar(actasmpattern);
                      if (actasmpattern = '%ST') and (c='(') then
                      Begin
                         actasmpattern:=actasmpattern+c;
-                        c:=asmgetchar;
+                        c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                         if c in ['0'..'9'] then
                           actasmpattern := actasmpattern + c
                         else
                           Message(assem_e_invalid_fpu_register);
-                        c:=asmgetchar;
+                        c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                         if c <> ')' then
                           Message(assem_e_invalid_fpu_register)
                         else
                         Begin
                           actasmpattern := actasmpattern + c;
-                          c:=asmgetchar; { let us point to next character. }
+                          c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar; { let us point to next character. }
                         end;
                      end;
                      is_register(actasmpattern, token);
@@ -747,11 +747,11 @@ const
            { integer number }
            '1'..'9': begin
                         actasmpattern := c;
-                        c := asmgetchar;
+                        c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                         while c in ['0'..'9'] do
                           Begin
                              actasmpattern := actasmpattern + c;
-                             c:= asmgetchar;
+                             c:= {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                           end;
                         gettoken := AS_INTNUM;
                         exit;
@@ -759,57 +759,57 @@ const
            '0': begin
                 { octal,hexa,real or binary number. }
                  actasmpattern := c;
-                 c:=asmgetchar;
+                 c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                  case upcase(c) of
                    { binary }
                    'B': Begin
-                          c:=asmgetchar;
+                          c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                           while c in ['0','1'] do
                           Begin
                             actasmpattern := actasmpattern + c;
-                            c := asmgetchar;
+                            c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                           end;
                           gettoken := AS_BINNUM;
                           exit;
                         end;
                    { real }
                    'D': Begin
-                          c:=asmgetchar;
+                          c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                           { get ridd of the 0d }
                           if (c='+') or (c='-') then
                             begin
                                actasmpattern:=c;
-                               c:=asmgetchar;
+                               c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                             end
                           else
                             actasmpattern:='';
                         while c in ['0'..'9'] do
                           Begin
                              actasmpattern := actasmpattern + c;
-                             c:= asmgetchar;
+                             c:= {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                           end;
                         if c='.' then
                           begin
                              actasmpattern := actasmpattern + c;
-                             c:=asmgetchar;
+                             c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                              while c in ['0'..'9'] do
                                Begin
                                   actasmpattern := actasmpattern + c;
-                                  c:= asmgetchar;
+                                  c:= {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                                end;
                              if upcase(c) = 'E' then
                                begin
                                   actasmpattern := actasmpattern + c;
-                                  c:=asmgetchar;
+                                  c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                                   if (c = '+') or (c = '-') then
                                     begin
                                        actasmpattern := actasmpattern + c;
-                                       c:=asmgetchar;
+                                       c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                                     end;
                                   while c in ['0'..'9'] do
                                     Begin
                                        actasmpattern := actasmpattern + c;
-                                       c:= asmgetchar;
+                                       c:= {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                                     end;
                                end;
                              gettoken := AS_REALNUM;
@@ -820,11 +820,11 @@ const
                         end;
                    { hexadecimal }
                    'X': Begin
-                          c:=asmgetchar;
+                          c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                           while c in ['0'..'9','a'..'f','A'..'F'] do
                           Begin
                             actasmpattern := actasmpattern + c;
-                            c := asmgetchar;
+                            c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                           end;
                           gettoken := AS_HEXNUM;
                           exit;
@@ -835,7 +835,7 @@ const
                                while c in ['0'..'7'] do
                                Begin
                                  actasmpattern := actasmpattern + c;
-                                 c := asmgetchar;
+                                 c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                                end;
                                gettoken := AS_OCTALNUM;
                                exit;
@@ -847,10 +847,9 @@ const
                       end;
                    end; { end case }
                 end;
-
-         '{',#13,newline,';' : begin
+    '{',#13,newline,';' : begin
                             { the comment is read by asmgetchar }
-                            c:=asmgetchar;
+                            c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                             firsttoken := TRUE;
                             gettoken:=AS_SEPARATOR;
                            end;
@@ -3415,7 +3414,7 @@ const
     store_p:=p;
     { setup label linked list }
     labellist.init;
-    c:=asmgetchar;
+    c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
     actasmtoken:=gettoken;
     while actasmtoken<>AS_END do
     Begin
@@ -3691,7 +3690,10 @@ end.
 
 {
   $Log$
-  Revision 1.2  1998-06-24 14:06:36  peter
+  Revision 1.3  1998-07-07 11:20:07  peter
+    + NEWINPUT for a better inputfile and scanner object
+
+  Revision 1.2  1998/06/24 14:06:36  peter
     * fixed the name changes
 
   Revision 1.1  1998/06/23 14:00:17  peter

compiler/ra386dir.pas

@@ -73,13 +73,11 @@ unit Ra386dir;
          retstr:=upper(tostr(procinfo.retoffset)+'('+att_reg2str[procinfo.framepointer]+')')
        else
          retstr:='';
-         c:=asmgetchar;
+         c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
          code:=new(paasmoutput,init);
          while not(ende) do
            begin
-              tokenpos.line:=current_module^.current_inputfile^.line_no;
-              tokenpos.column:=get_file_col;
-              tokenpos.fileindex:=current_module^.current_index;
+              {$ifdef NEWINPUT}current_scanner^.{$endif}gettokenpos;
               case c of
                  'A'..'Z','a'..'z','_' : begin
                       hs:='';
@@ -90,7 +88,7 @@ unit Ra386dir;
                         begin
                            inc(byte(hs[0]));
                            hs[length(hs)]:=c;
-                           c:=asmgetchar;
+                           c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                         end;
                       if upper(hs)='END' then
                          ende:=true
@@ -221,14 +219,14 @@ unit Ra386dir;
                       if pos(retstr,s) > 0 then
                         procinfo.funcret_is_valid:=true;
                      writeasmline;
-                     c:=asmgetchar;
+                     c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    end;
              #26 : Message(scan_f_end_of_file);
              else
                begin
                  inc(byte(s[0]));
                  s[length(s)]:=c;
-                 c:=asmgetchar;
+                 c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                end;
            end;
          end;
@@ -239,7 +237,10 @@ unit Ra386dir;
 end.
 {
   $Log$
-  Revision 1.2  1998-06-24 14:06:37  peter
+  Revision 1.3  1998-07-07 11:20:08  peter
+    + NEWINPUT for a better inputfile and scanner object
+
+  Revision 1.2  1998/06/24 14:06:37  peter
     * fixed the name changes
 
   Revision 1.1  1998/06/23 14:00:18  peter

compiler/ra386int.pas

@@ -42,12 +42,6 @@ Unit Ra386int;
 {    table will be completed.                                        }
 { o Add imul,shld and shrd support with references and CL            }
 {    i386.pas requires to be updated to do this.                     }
-{ o Support for (* *) tp styled comments, this support should be     }
-{   added in asmgetchar in scanner.pas (it cannot be implemented     }
-{   here without causing errors such as in :                         }
-{   (* "openbrace" AComment *)                                       }
-{   (presently an infinite loop will be created if a (* styled       }
-{    comment is found).                                              }
 { o Bugfix of ao_imm8s for IMUL. (Currently the 3 operand imul will  }
 {   be considered as invalid because I use ao_imm8 and the table     }
 {   uses ao_imm8s).                                                  }
@@ -338,12 +332,10 @@ var
     token := AS_NONE;
     { while space and tab , continue scan... }
     while (c in [' ',#9]) do
-      c := asmgetchar;
+      c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
     { Possiblities for first token in a statement:                }
     {   Local Label, Label, Directive, Prefix or Opcode....       }
-    tokenpos.line:=current_module^.current_inputfile^.line_no;
-    tokenpos.column:=get_file_col;
-    tokenpos.fileindex:=current_module^.current_index;
+    {$ifdef NEWINPUT}current_scanner^.{$endif}gettokenpos;
     if firsttoken and not (c in [newline,#13,'{',';']) then
     begin
       firsttoken := FALSE;
@@ -351,7 +343,7 @@ var
       begin
         token := AS_LLABEL;   { this is a local label }
         { Let us point to the next character }
-        c := asmgetchar;
+        c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
       end;
 
 
@@ -361,7 +353,7 @@ var
          { if there is an at_sign, then this must absolutely be a label }
          if c = '@' then forcelabel:=TRUE;
          actasmpattern := actasmpattern + c;
-         c := asmgetchar;
+         c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
       end;
 
       uppervar(actasmpattern);
@@ -373,7 +365,7 @@ var
              AS_LLABEL: ; { do nothing }
            end; { end case }
            { let us point to the next character }
-           c := asmgetchar;
+           c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
            gettoken := token;
            exit;
       end;
@@ -412,11 +404,11 @@ var
                 {                - @Result, @Code or @Data special variables.     }
                             begin
                              actasmpattern := c;
-                             c:= asmgetchar;
+                             c:= {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                              while c in  ['A'..'Z','a'..'z','0'..'9','_','@'] do
                              begin
                                actasmpattern := actasmpattern + c;
-                               c := asmgetchar;
+                               c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                              end;
                              uppervar(actasmpattern);
                              gettoken := AS_ID;
@@ -425,11 +417,11 @@ var
       { identifier, register, opcode, prefix or directive }
          'A'..'Z','a'..'z','_': begin
                              actasmpattern := c;
-                             c:= asmgetchar;
+                             c:= {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                              while c in  ['A'..'Z','a'..'z','0'..'9','_'] do
                              begin
                                actasmpattern := actasmpattern + c;
-                               c := asmgetchar;
+                               c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                              end;
                              uppervar(actasmpattern);
 
@@ -460,7 +452,7 @@ var
            { override operator... not supported }
            '&':       begin
                          Message(assem_w_override_op_not_supported);
-                         c:=asmgetchar;
+                         c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                          gettoken := AS_NONE;
                       end;
            { string or character }
@@ -471,7 +463,7 @@ var
                          begin
                            if c = '''' then
                            begin
-                              c:=asmgetchar;
+                              c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                               if c=newline then
                               begin
                                  Message(scan_f_string_exceeds_line);
@@ -480,11 +472,11 @@ var
                               repeat
                                   if c=''''then
                                    begin
-                                       c:=asmgetchar;
+                                       c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                                        if c='''' then
                                         begin
                                                actasmpattern:=actasmpattern+'''';
-                                               c:=asmgetchar;
+                                               c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                                                if c=newline then
                                                begin
                                                     Message(scan_f_string_exceeds_line);
@@ -496,7 +488,7 @@ var
                                    else
                                    begin
                                           actasmpattern:=actasmpattern+c;
-                                          c:=asmgetchar;
+                                          c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                                           if c=newline then
                                             begin
                                                Message(scan_f_string_exceeds_line);
@@ -519,7 +511,7 @@ var
                          begin
                            if c = '"' then
                            begin
-                              c:=asmgetchar;
+                              c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                               if c=newline then
                               begin
                                  Message(scan_f_string_exceeds_line);
@@ -528,11 +520,11 @@ var
                               repeat
                                   if c='"'then
                                    begin
-                                       c:=asmgetchar;
+                                       c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                                        if c='"' then
                                         begin
                                                actasmpattern:=actasmpattern+'"';
-                                               c:=asmgetchar;
+                                               c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                                                if c=newline then
                                                begin
                                                   Message(scan_f_string_exceeds_line);
@@ -545,7 +537,7 @@ var
                                   else
                                    begin
                                           actasmpattern:=actasmpattern+c;
-                                          c:=asmgetchar;
+                                          c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                                           if c=newline then
                                             begin
                                                Message(scan_f_string_exceeds_line);
@@ -561,68 +553,68 @@ var
                    exit;
                  end;
            '$' :  begin
-                    c:=asmgetchar;
+                    c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                     while c in ['0'..'9','A'..'F','a'..'f'] do
                     begin
                       actasmpattern := actasmpattern + c;
-                      c := asmgetchar;
+                      c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                     end;
                    gettoken := AS_HEXNUM;
                    exit;
                   end;
            ',' : begin
                    gettoken := AS_COMMA;
-                   c:=asmgetchar;
+                   c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    exit;
                  end;
            '[' : begin
                    gettoken := AS_LBRACKET;
-                   c:=asmgetchar;
+                   c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    exit;
                  end;
            ']' : begin
                    gettoken := AS_RBRACKET;
-                   c:=asmgetchar;
+                   c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    exit;
                  end;
            '(' : begin
                    gettoken := AS_LPAREN;
-                   c:=asmgetchar;
+                   c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    exit;
                  end;
            ')' : begin
                    gettoken := AS_RPAREN;
-                   c:=asmgetchar;
+                   c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    exit;
                  end;
            ':' : begin
                    gettoken := AS_COLON;
-                   c:=asmgetchar;
+                   c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    exit;
                  end;
            '.' : begin
                    gettoken := AS_DOT;
-                   c:=asmgetchar;
+                   c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    exit;
                  end;
            '+' : begin
                    gettoken := AS_PLUS;
-                   c:=asmgetchar;
+                   c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    exit;
                  end;
            '-' : begin
                    gettoken := AS_MINUS;
-                   c:=asmgetchar;
+                   c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    exit;
                  end;
            '*' : begin
                    gettoken := AS_STAR;
-                   c:=asmgetchar;
+                   c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    exit;
                  end;
            '/' : begin
                    gettoken := AS_SLASH;
-                   c:=asmgetchar;
+                   c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                    exit;
                  end;
            '0'..'9': begin
@@ -630,12 +622,12 @@ var
                           { if so, then we use a default value instead.}
                           errorflag := false;
                           actasmpattern := c;
-                          c := asmgetchar;
+                          c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                           { Get the possible characters }
                           while c in ['0'..'9','A'..'F','a'..'f'] do
                           begin
                             actasmpattern := actasmpattern + c;
-                            c:= asmgetchar;
+                            c:= {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                           end;
                           { Get ending character }
                           uppervar(actasmpattern);
@@ -671,7 +663,7 @@ var
                                      if errorflag then
                                         actasmpattern := '0';
                                       gettoken := AS_OCTALNUM;
-                                      c := asmgetchar;
+                                      c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                                       exit;
                                     end;
                               'H': Begin
@@ -685,7 +677,7 @@ var
                                      if errorflag then
                                         actasmpattern := '0';
                                      gettoken := AS_HEXNUM;
-                                     c := asmgetchar;
+                                     c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                                      exit;
                                    end;
                               else { must be an integer number }
@@ -706,7 +698,7 @@ var
                       end; { end if }
                      end;
     ';','{',#13,newline : begin
-                            c:=asmgetchar;
+                            c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
                             firsttoken := TRUE;
                             gettoken:=AS_SEPARATOR;
                            end;
@@ -3261,7 +3253,7 @@ var
     p:=new(paasmoutput,init);
     { setup label linked list }
     labellist.init;
-    c:=asmgetchar;
+    c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
     actasmtoken:=gettoken;
     while actasmtoken<>AS_END do
     Begin
@@ -3376,7 +3368,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.2  1998-06-24 14:06:38  peter
+  Revision 1.3  1998-07-07 11:20:09  peter
+    + NEWINPUT for a better inputfile and scanner object
+
+  Revision 1.2  1998/06/24 14:06:38  peter
     * fixed the name changes
 
   Revision 1.1  1998/06/23 14:00:18  peter

compiler/scandir.inc

@@ -86,7 +86,8 @@ const
       preprocpat    : string;
       preproc_token : ttoken;
 
-    function read_preproc : ttoken;
+{$ifndef NEWINPUT}
+    function readpreproc:ttoken;
       begin
          skipspace;
          case c of
@@ -94,74 +95,74 @@ const
         'a'..'z',
     '_','0'..'9' : begin
                      preprocpat:=readid;
-                     read_preproc:=ID;
+                     readpreproc:=ID;
                    end;
              '(' : begin
                      readchar;
-                     read_preproc:=LKLAMMER;
+                     readpreproc:=LKLAMMER;
                    end;
              ')' : begin
                      readchar;
-                     read_preproc:=RKLAMMER;
+                     readpreproc:=RKLAMMER;
                    end;
              '+' : begin
                      readchar;
-                     read_preproc:=PLUS;
+                     readpreproc:=PLUS;
                    end;
              '-' : begin
                      readchar;
-                     read_preproc:=MINUS;
+                     readpreproc:=MINUS;
                    end;
              '*' : begin
                      readchar;
-                     read_preproc:=STAR;
+                     readpreproc:=STAR;
                    end;
              '/' : begin
                      readchar;
-                     read_preproc:=SLASH;
+                     readpreproc:=SLASH;
                    end;
              '=' : begin
                      readchar;
-                     read_preproc:=EQUAL;
+                     readpreproc:=EQUAL;
                    end;
              '>' : begin
                      readchar;
                      if c='=' then
                       begin
                         readchar;
-                        read_preproc:=GTE;
+                        readpreproc:=GTE;
                       end
                      else
-                      read_preproc:=GT;
+                      readpreproc:=GT;
                    end;
              '<' : begin
                      readchar;
                      case c of
                       '>' : begin
                               readchar;
-                              read_preproc:=UNEQUAL;
+                              readpreproc:=UNEQUAL;
                             end;
                       '=' : begin
                               readchar;
-                              read_preproc:=LTE;
+                              readpreproc:=LTE;
                             end;
-                     else   read_preproc:=LT;
+                     else   readpreproc:=LT;
                      end;
                    end;
              #26 : Message(scan_f_end_of_file);
          else
           begin
-            read_preproc:=_EOF;
+            readpreproc:=_EOF;
           end;
          end;
       end;
-
+{$endif}
 
     procedure preproc_consume(t : ttoken);
       begin
-         if t<>preproc_token then
-          Message(scan_e_preproc_syntax_error);
-         preproc_token:=read_preproc;
+        if t<>preproc_token then
+         Message(scan_e_preproc_syntax_error);
+        preproc_token:={$ifdef NEWINPUT}current_scanner^.{$endif}readpreproc;
       end;
 
     function read_expr : string;forward;
@@ -342,19 +343,6 @@ const
 
 
     procedure dir_conditional(t:tdirectivetoken);
-
-       procedure newpreproc(isifdef,a:boolean;const s:string;w:tmsgconst);
-       begin
-         preprocstack:=new(ppreprocstack,init(isifdef,
-           ((preprocstack=nil) or preprocstack^.accept) and a,preprocstack));
-         preprocstack^.name:=s;
-         preprocstack^.line_nb:=current_module^.current_inputfile^.line_no;
-         if preprocstack^.accept then
-          Message2(w,preprocstack^.name,'accepted')
-         else
-          Message2(w,preprocstack^.name,'rejected');
-       end;
-
       var
         hs    : string;
         mac   : pmacrosym;
@@ -364,50 +352,37 @@ const
          begin
            case t of
    _DIR_ENDIF : begin
-                { we can always accept an ELSE }
-                  if assigned(preprocstack) then
-                   begin
-                     Message1(scan_c_endif_found,preprocstack^.name);
-                     if not preprocstack^.isifdef then
-                      popstack;
-                   end
-                  else
-                   Message(scan_e_endif_without_if);
-                { now pop the condition }
-                  if assigned(preprocstack) then
-                   begin
-                   { we only use $ifdef in the stack }
-                     if preprocstack^.isifdef then
-                      popstack
-                     else
-                      Message(scan_e_too_much_endifs);
-                   end
-                  else
-                   Message(scan_e_endif_without_if);
+                  {$ifdef NEWINPUT}current_scanner^.{$endif}poppreprocstack;
                 end;
     _DIR_ELSE : begin
-                  if assigned(preprocstack) then
-                   begin
-                     preprocstack:=new(ppreprocstack,init(false,
-                       not(preprocstack^.accept) and
-                       ((preprocstack^.next=nil) or (preprocstack^.next^.accept)),preprocstack));
-                     preprocstack^.line_nb:=current_module^.current_inputfile^.line_no;
-                     preprocstack^.name:=preprocstack^.next^.name;
-                     if preprocstack^.accept then
-                      Message2(scan_c_else_found,preprocstack^.name,'accepted')
-                     else
-                      Message2(scan_c_else_found,preprocstack^.name,'rejected');
-                   end
-                  else
-                   Message(scan_e_endif_without_if);
+                  {$ifdef NEWINPUT}current_scanner^.{$endif}elsepreprocstack;
                 end;
    _DIR_IFDEF : begin
+{$ifdef NEWINPUT}
+                  current_scanner^.skipspace;
+                  hs:=current_scanner^.readid;
+                  mac:=pmacrosym(macros^.search(hs));
+                  current_scanner^.addpreprocstack(assigned(mac) and mac^.defined,hs,scan_c_ifdef_found);
+{$else}
                   skipspace;
                   hs:=readid;
                   mac:=pmacrosym(macros^.search(hs));
-                  newpreproc(true,assigned(mac) and mac^.defined,hs,scan_c_ifdef_found);
+                  addpreprocstack(assigned(mac) and mac^.defined,hs,scan_c_ifdef_found);
+{$endif}
                 end;
    _DIR_IFOPT : begin
+{$ifdef NEWINPUT}
+                  current_scanner^.skipspace;
+                  hs:=current_scanner^.readid;
+                  if (length(hs)=1) and (c in ['-','+']) then
+                   begin
+                     found:=CheckSwitch(hs[1],c);
+                     current_scanner^.readchar; {read + or -}
+                   end
+                  else
+                   Message(scan_w_illegal_switch);
+                  current_scanner^.addpreprocstack(found,hs,scan_c_ifopt_found);
+{$else}
                   skipspace;
                   hs:=readid;
                   if (length(hs)=1) and (c in ['-','+']) then
@@ -417,23 +392,53 @@ const
                    end
                   else
                    Message(scan_w_illegal_switch);
-                  newpreproc(true,found,hs,scan_c_ifopt_found);
+                  addpreprocstack(found,hs,scan_c_ifopt_found);
+{$endif}
                 end;
       _DIR_IF : begin
+{$ifdef NEWINPUT}
+                  current_scanner^.skipspace;
+                  { start preproc expression scanner }
+                  preproc_token:=current_scanner^.readpreproc;
+                  hs:=read_expr;
+                  current_scanner^.addpreprocstack(hs<>'0',hs,scan_c_if_found);
+{$else}
                   skipspace;
                   { start preproc expression scanner }
-                  preproc_token:=read_preproc;
+                  preproc_token:=readpreproc;
                   hs:=read_expr;
-                  newpreproc(true,hs<>'0',hs,scan_c_if_found);
+                  addpreprocstack(hs<>'0',hs,scan_c_if_found);
+{$endif}
                 end;
   _DIR_IFNDEF : begin
+{$ifdef NEWINPUT}
+                  current_scanner^.skipspace;
+                  hs:=current_scanner^.readid;
+                  mac:=pmacrosym(macros^.search(hs));
+                  current_scanner^.addpreprocstack(not(assigned(mac) and mac^.defined),hs,scan_c_ifndef_found);
+{$else}
                   skipspace;
                   hs:=readid;
                   mac:=pmacrosym(macros^.search(hs));
-                  newpreproc(true,not(assigned(mac) and mac^.defined),hs,scan_c_ifndef_found);
+                  addpreprocstack(not(assigned(mac) and mac^.defined),hs,scan_c_ifndef_found);
+{$endif}
                 end;
            end;
          { accept the text ? }
+{$ifdef NEWINPUT}
+           if (current_scanner^.preprocstack=nil) or current_scanner^.preprocstack^.accept then
+            break
+           else
+            begin
+              Message(scan_c_skipping_until);
+              repeat
+                current_scanner^.skipuntildirective;
+                t:=Get_Directive(current_scanner^.readid);
+              until is_conditional(t);
+              Message1(scan_d_handling_switch,'$'+directive[t]);
+            end;
+         end;
+{$else}
            if (preprocstack=nil) or preprocstack^.accept then
             break
            else
@@ -445,6 +450,7 @@ const
               until is_conditional(t);
             end;
          end;
+{$endif}
       end;
 
 
@@ -454,9 +460,11 @@ const
         hs2,
         hs  : string;
         mac : pmacrosym;
+        macropos : longint;
+        macrobuffer : pmacrobuffer;
       begin
-        skipspace;
-        hs:=readid;
+        {$ifdef NEWINPUT}current_scanner^.{$endif}skipspace;
+        hs:={$ifdef NEWINPUT}current_scanner^.{$endif}readid;
         mac:=pmacrosym(macros^.search(hs));
         if not assigned(mac) then
           begin
@@ -485,20 +493,21 @@ const
               Message(scan_e_keyword_cant_be_a_macro);
              pattern:=hs2;
            { !!!!!! handle macro params, need we this? }
-             skipspace;
+             {$ifdef NEWINPUT}current_scanner^.{$endif}skipspace;
            { may be a macro? }
              if c=':' then
                begin
-                  readchar;
+                  {$ifdef NEWINPUT}current_scanner^.{$endif}readchar;
                   if c='=' then
                     begin
-                       { first char }
-                       readchar;
+                       new(macrobuffer);
                        macropos:=0;
+                       { first char }
+                       {$ifdef NEWINPUT}current_scanner^.{$endif}readchar;
                        while (c<>'}') do
                          begin
                             macrobuffer^[macropos]:=c;
-                            readchar;
+                            {$ifdef NEWINPUT}current_scanner^.{$endif}readchar;
                             if c=#26 then Message(scan_f_end_of_file);
                             inc(macropos);
                             if macropos>maxmacrolen then
@@ -512,6 +521,7 @@ const
                        mac^.buflen:=macropos;
                        { copy the text }
                        move(macrobuffer^,mac^.buftext^,macropos);
+                       dispose(macrobuffer);
                     end;
                end;
           end;
@@ -523,8 +533,8 @@ const
         hs  : string;
         mac : pmacrosym;
       begin
-        skipspace;
-        hs:=readid;
+        {$ifdef NEWINPUT}current_scanner^.{$endif}skipspace;
+        hs:={$ifdef NEWINPUT}current_scanner^.{$endif}readid;
         mac:=pmacrosym(macros^.search(hs));
         if not assigned(mac) then
           begin
@@ -560,8 +570,8 @@ const
     _DIR_MESSAGE,
        _DIR_INFO : w:=scan_i_user_defined;
         end;
-        skipspace;
-        Message1(w,readcomment);
+        {$ifdef NEWINPUT}current_scanner^.{$endif}skipspace;
+        Message1(w,{$ifdef NEWINPUT}current_scanner^.{$endif}readcomment);
       end;
 
 
@@ -576,7 +586,7 @@ const
 {$endif}
    _DIR_SMARTLINK : sw:=cs_smartlink;
         end;
-        skipspace;
+        {$ifdef NEWINPUT}current_scanner^.{$endif}skipspace;
         if c='-' then
          aktswitches:=aktswitches-[sw]
         else
@@ -593,12 +603,29 @@ const
         hp    : pinputfile;
         found : boolean;
       begin
-        skipspace;
-        hs:=readcomment;
+        {$ifdef NEWINPUT}current_scanner^.{$endif}skipspace;
+        hs:={$ifdef NEWINPUT}current_scanner^.{$endif}readcomment;
         while (hs<>'') and (hs[length(hs)]=' ') do
          dec(byte(hs[0]));
         hs:=FixFileName(hs);
         fsplit(hs,path,name,ext);
+{$ifdef NEWINPUT}
+      { first look in the path of _d then currentmodule }
+        path:=search(hs,path+';'+current_scanner^.inputfile^.path^+';'+includesearchpath,found);
+      { shutdown current file }
+        current_scanner^.close;
+      { load new file }
+        hp:=new(pinputfile,init(path+name+ext));
+        current_scanner^.addfile(hp);
+        if not current_scanner^.open then
+         Message1(scan_f_cannot_open_includefile,hs);
+        status.currentsource:=current_scanner^.inputfile^.name^;
+        Message1(scan_u_start_include_file,current_scanner^.inputfile^.name^);
+        current_scanner^.reload;
+      { register for refs }
+        current_module^.sourcefiles.register_file(hp);
+        current_module^.current_index:=hp^.ref_index;
+{$else}
       { first look in the path of _d then currentmodule }
         path:=search(hs,path+';'+current_module^.current_inputfile^.path^+';'+includesearchpath,found);
         hp:=new(pinputfile,init(path,name,ext));
@@ -617,6 +644,7 @@ const
          end
         else
          Message1(scan_f_cannot_open_includefile,hs);
+{$endif NEWINPUT}
       end;
 
 
@@ -627,29 +655,28 @@ const
 
     procedure dir_linkobject(t:tdirectivetoken);
       begin
-        skipspace;
-        current_module^.linkofiles.insert(FixFileName(readstring));
+        {$ifdef NEWINPUT}current_scanner^.{$endif}skipspace;
+        {$ifdef NEWINPUT}current_scanner^.{$endif}readstring;
+        current_module^.linkofiles.insert(FixFileName(orgpattern));
       end;
 
 
     procedure dir_linklib(t:tdirectivetoken);
       begin
-        skipspace;
-        current_module^.linkSharedLibs.insert(readstring);
+        {$ifdef NEWINPUT}current_scanner^.{$endif}skipspace;
+        {$ifdef NEWINPUT}current_scanner^.{$endif}readstring;
+        current_module^.linkSharedLibs.insert(orgpattern);
       end;
 
 
     procedure dir_outputformat(t:tdirectivetoken);
-      var
-        hs : string;
       begin
         if not current_module^.in_main then
          Message(scan_w_switch_is_global)
         else
           begin
-            skipspace;
-            hs:=readid;
-            if set_string_asm(hs) then
+            {$ifdef NEWINPUT}current_scanner^.{$endif}skipspace;
+            if set_string_asm({$ifdef NEWINPUT}current_scanner^.{$endif}readid) then
              aktoutputformat:=target_asm.id
             else
              Message(scan_w_illegal_switch);
@@ -661,10 +688,10 @@ const
       var
         hs : string;
       begin
-        skipspace;
+        {$ifdef NEWINPUT}current_scanner^.{$endif}skipspace;
         if upcase(c)='N' then
          begin
-           hs:=readid;
+           hs:={$ifdef NEWINPUT}current_scanner^.{$endif}readid;
            if hs='NORMAL' then
             aktpackrecords:=2
            else
@@ -672,7 +699,7 @@ const
          end
         else
          begin
-           case readval of
+           case {$ifdef NEWINPUT}current_scanner^.{$endif}readval of
             1 : aktpackrecords:=1;
             2 : aktpackrecords:=2;
             4 : aktpackrecords:=4;
@@ -692,14 +719,13 @@ const
       var
         s : string;
       begin
-        skipspace;
-        s:=readid;
+        {$ifdef NEWINPUT}current_scanner^.{$endif}skipspace;
+        s:={$ifdef NEWINPUT}current_scanner^.{$endif}readid;
         if s='DEFAULT' then
          aktasmmode:=initasmmode
         else
          if not set_string_asmmode(s,aktasmmode) then
           Comment(V_Warning,'Unsupported asm mode specified '+s);
-
       end;
 
     procedure dir_oldasmmode(t:tdirectivetoken);
@@ -726,7 +752,6 @@ const
         end;
       { c contains the next char, a + or - would be fine }
         HandleSwitch(sw,c);
-        ReadComment;
       end;
 
 
@@ -775,12 +800,13 @@ const
 
     procedure handledirectives;
       var
-        t     : tdirectivetoken;
-        p     : tdirectiveproc;
-        hs    : string;
+        t  : tdirectivetoken;
+        p  : tdirectiveproc;
+        hs : string;
       begin
-         readchar; {Remove the $}
-         hs:=readid;
+         {$ifdef NEWINPUT}current_scanner^.{$endif}gettokenpos;
+         {$ifdef NEWINPUT}current_scanner^.{$endif}readchar; {Remove the $}
+         hs:={$ifdef NEWINPUT}current_scanner^.{$endif}readid;
          Message1(scan_d_handling_switch,'$'+hs);
          if hs='' then
           Message1(scan_w_illegal_switch,'$'+hs);
@@ -788,11 +814,11 @@ const
          while (length(hs)=1) and (c in ['-','+']) do
           begin
             HandleSwitch(hs[1],c);
-            readchar; {Remove + or -}
+            {$ifdef NEWINPUT}current_scanner^.{$endif}readchar; {Remove + or -}
             if c=',' then
              begin
-               readchar;   {Remove , }
-               hs:=readid; {Check for multiple switches on one line}
+               {$ifdef NEWINPUT}current_scanner^.{$endif}readchar;   {Remove , }
+               hs:={$ifdef NEWINPUT}current_scanner^.{$endif}readid; {Check for multiple switches on one line}
                Message1(scan_d_handling_switch,'$'+hs);
              end
             else
@@ -815,14 +841,17 @@ const
             else
              Message1(scan_w_illegal_directive,'$'+hs);
           { conditionals already read the comment }
-            if (comment_level>0) then
-             readcomment;
+            if ({$ifdef NEWINPUT}current_scanner^.{$endif}comment_level>0) then
+             {$ifdef NEWINPUT}current_scanner^.{$endif}readcomment;
           end;
       end;
 
 {
   $Log$
-  Revision 1.11  1998-06-04 23:51:59  peter
+  Revision 1.12  1998-07-07 11:20:10  peter
+    + NEWINPUT for a better inputfile and scanner object
+
+  Revision 1.11  1998/06/04 23:51:59  peter
     * m68k compiles
     + .def file creation moved to gendef.pas so it could also be used
       for win32

compiler/symdef.inc

@@ -85,7 +85,8 @@
          if not(assigned(previousglobal)) then
            begin
               firstglobaldef := nextglobal;
-              firstglobaldef^.previousglobal:=nil;
+              if assigned(firstglobaldef) then
+                firstglobaldef^.previousglobal:=nil;
            end
          else
            begin
@@ -284,7 +285,8 @@
 
       var
          str : string;
-         
+
+
       begin
          { name }
          if assigned(sym) then
@@ -2644,7 +2646,10 @@
 
 {
   $Log$
-  Revision 1.15  1998-06-24 14:48:37  peter
+  Revision 1.16  1998-07-07 11:20:13  peter
+    + NEWINPUT for a better inputfile and scanner object
+
+  Revision 1.15  1998/06/24 14:48:37  peter
     * ifdef newppu -> ifndef oldppu
 
   Revision 1.14  1998/06/16 08:56:31  peter

compiler/symppu.inc

@@ -132,6 +132,30 @@
       end;
 
 
+{$ifdef NEWINPUT}
+
+    procedure writesourcefiles;
+      var
+        hp    : pinputfile;
+        index : longint;
+      begin
+      { second write the used source files }
+        hp:=current_module^.sourcefiles.files;
+        index:=current_module^.sourcefiles.last_ref_index;
+        while assigned(hp) do
+         begin
+         { only name and extension }
+           current_ppu^.putstring(hp^.name^);
+         { index in that order }
+           hp^.ref_index:=index;
+           dec(index);
+           hp:=hp^.ref_next;
+         end;
+        current_ppu^.writeentry(ibsourcefiles);
+      end;
+
+{$else}
+
     procedure writesourcefiles;
       var
         hp2   : pextfile;
@@ -152,6 +176,7 @@
         current_ppu^.writeentry(ibsourcefiles);
       end;
 
+{$endif NEWINPUT}
 
     procedure writeusedunit;
       var
@@ -697,7 +722,10 @@
 
 {
   $Log$
-  Revision 1.5  1998-06-24 14:48:39  peter
+  Revision 1.6  1998-07-07 11:20:14  peter
+    + NEWINPUT for a better inputfile and scanner object
+
+  Revision 1.5  1998/06/24 14:48:39  peter
     * ifdef newppu -> ifndef oldppu
 
   Revision 1.4  1998/06/16 08:56:32  peter

compiler/symsym.inc

@@ -34,10 +34,14 @@
 {$ifdef GDB}
          isstabwritten := false;
 {$endif GDB}
+{$ifdef NEWINPUT}
+         line_no:=aktfilepos.line;
+{$else}
          if assigned(current_module) and assigned(current_module^.current_inputfile) then
            line_no:=current_module^.current_inputfile^.line_no
          else
            line_no:=0;
+{$endif NEWINPUT}
 {$ifdef UseBrowser}
          defref:=nil;
          lastwritten:=nil;
@@ -539,7 +543,12 @@
       end;
      stabstring :=strpnew('"'+obj+':'+RetType
            +definition^.retdef^.numberstring+info+'",'+tostr(n_function)
-           +',0,'+tostr(current_module^.current_inputfile^.line_no)
+           +',0,'+
+{$ifdef NEWINPUT}
+           tostr(aktfilepos.line)
+{$else}
+           tostr(current_module^.current_inputfile^.line_no)
+{$endif}
            +','+definition^.mangledname);
     end;
 
@@ -1647,7 +1656,10 @@
 
 {
   $Log$
-  Revision 1.17  1998-06-24 14:48:40  peter
+  Revision 1.18  1998-07-07 11:20:15  peter
+    + NEWINPUT for a better inputfile and scanner object
+
+  Revision 1.17  1998/06/24 14:48:40  peter
     * ifdef newppu -> ifndef oldppu
 
   Revision 1.16  1998/06/19 15:40:42  peter

compiler/tree.pas

@@ -283,7 +283,9 @@ unit tree;
     procedure set_location(var destloc,sourceloc : tlocation);
     procedure swap_location(var destloc,sourceloc : tlocation);
     procedure set_file_line(from,_to : ptree);
+{$ifndef NEWINPUT}
     procedure set_current_file_line(_to : ptree);
+{$endif}
     procedure set_tree_filepos(p : ptree;const filepos : tfileposinfo);
 {$ifdef extdebug}
     procedure compare_trees(oldp,p : ptree);
@@ -574,6 +576,7 @@ unit tree;
            _to^.fileinfo:=from^.fileinfo;
       end;
 
+{$ifndef NEWINPUT}
     procedure set_current_file_line(_to : ptree);
 
       begin
@@ -582,6 +585,7 @@ unit tree;
          current_module^.current_inputfile^.line_no:=_to^.fileinfo.line;
          current_module^.current_index:=_to^.fileinfo.fileindex;
       end;
+{$endif}
 
    procedure set_tree_filepos(p : ptree;const filepos : tfileposinfo);
      begin
@@ -1605,7 +1609,10 @@ unit tree;
 end.
 {
   $Log$
-  Revision 1.17  1998-06-22 08:59:03  daniel
+  Revision 1.18  1998-07-07 11:20:18  peter
+    + NEWINPUT for a better inputfile and scanner object
+
+  Revision 1.17  1998/06/22 08:59:03  daniel
   - Removed pool of nodes.
 
   Revision 1.16  1998/06/12 14:50:49  peter

compiler/verb_def.pas

@@ -22,7 +22,6 @@
 }
 unit verb_def;
 interface
-uses verbose;
 
 procedure SetRedirectFile(const fn:string);
 
@@ -32,7 +31,11 @@ function  _internalerror(i : longint) : boolean;
 
 implementation
 uses
-  strings,dos,globals,files;
+  verbose,globals,
+{$ifndef NEWINPUT}
+   files,
+{$endif}
+  strings,dos;
 
 const
   { RHIDE expect gcc like error output }
@@ -100,7 +103,7 @@ begin
       begin
         if (status.compiledlines=1) then
           WriteLn(memavail shr 10,' Kb Free');
-        if (status.currentline mod 100=0) then
+        if (status.currentline>0) and (status.currentline mod 100=0) then
 {$ifdef FPC}
           WriteLn(status.currentline,' ',memavail shr 10,'/',system.heapsize shr 10,' Kb Free');
 {$else}
@@ -137,8 +140,18 @@ begin
             if (verbosity and Level)=V_Fatal then
               hs:=rh_errorstr;
           end;
+{$ifdef NEWINPUT}
+        if (Level<$100) and (status.currentline>0) then
+         begin
+           if Use_Rhide then
+             hs:=lower(bstoslash(status.currentsource))+':'+tostr(status.currentline)+': '+hs
+           else
+             hs:=status.currentsource+'('+tostr(status.currentline)+','+tostr(status.currentcolumn)+') '+hs;
+         end;
+{$else}
         if (Level<$100) and Assigned(current_module) and Assigned(current_module^.current_inputfile) then
           hs:=current_module^.current_inputfile^.get_file_line+' '+hs;
+{$endif NEWINPUT}
       { add the message to the text }
         hs:=hs+s;
 {$ifdef FPC}
@@ -180,7 +193,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.11  1998-06-19 15:40:00  peter
+  Revision 1.12  1998-07-07 11:20:19  peter
+    + NEWINPUT for a better inputfile and scanner object
+
+  Revision 1.11  1998/06/19 15:40:00  peter
     * bp7 fix
 
   Revision 1.10  1998/06/16 11:32:19  peter

compiler/verbose.pas

@@ -56,10 +56,11 @@ Const
 
 type
   TCompileStatus = record
+    currentmodule,
     currentsource : string;   { filename }
-    currentline   : longint;  { current line number }
+    currentline,
+    currentcolumn : longint;  { current line and column }
     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;
 
@@ -94,8 +95,8 @@ var
 
 
 implementation
-uses globals;
-
+uses
+  globals;
 
 procedure LoadMsgFile(const fn:string);
 begin
@@ -226,6 +227,12 @@ begin
   dostop:=((l and V_Fatal)<>0);
   if (l and V_Error)<>0 then
    inc(status.errorcount);
+{ fix status }
+{$ifdef NEWINPUT}
+  status.currentline:=aktfilepos.line;
+  status.currentcolumn:=aktfilepos.column;
+{$endif}
+{ show comment }
   if do_comment(l,s) or dostop or (status.errorcount>=maxerrorcount) then
    stop
 end;
@@ -277,6 +284,12 @@ begin
   Delete(s,1,idx);
   Replace(s,'$VER',version_string);
   Replace(s,'$TARGET',target_string);
+{ fix status }
+{$ifdef NEWINPUT}
+  status.currentline:=aktfilepos.line;
+  status.currentcolumn:=aktfilepos.column;
+{$endif}
+{ show comment }
   if do_comment(v,s) or dostop or (status.errorcount>=maxerrorcount) then
    stop;
 end;
@@ -314,7 +327,10 @@ end.
 
 {
   $Log$
-  Revision 1.8  1998-05-23 01:21:35  peter
+  Revision 1.9  1998-07-07 11:20:20  peter
+    + NEWINPUT for a better inputfile and scanner object
+
+  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