diff --git a/compiler/aasm.pas b/compiler/aasm.pas index 7b3c964ec8..56350157c5 100644 --- a/compiler/aasm.pas +++ b/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 diff --git a/compiler/cgi386.pas b/compiler/cgi386.pas index 5f866512d1..5fc7778801 100644 --- a/compiler/cgi386.pas +++ b/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 diff --git a/compiler/cobjects.pas b/compiler/cobjects.pas index e75048e626..23948c1934 100644 --- a/compiler/cobjects.pas +++ b/compiler/cobjects.pas @@ -43,15 +43,15 @@ unit cobjects; type pstring = ^string; - tfileposinfo = record - line : longint; { could be changed to abspos } - fileindex,column : word; - end; pfileposinfo = ^tfileposinfo; + tfileposinfo = record + line : longint; + column : word; + fileindex : word; + end; { 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 diff --git a/compiler/files.pas b/compiler/files.pas index 9f72dec56f..35678a1f8f 100644 --- a/compiler/files.pas +++ b/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 diff --git a/compiler/parser.pas b/compiler/parser.pas index 3765fc4b82..b457511bc4 100644 --- a/compiler/parser.pas +++ b/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; +{$ifdef NEWINPUT} + oldaktfilepos:=aktfilepos; + oldcurrent_scanner:=current_scanner; +{$else} + oldcurrlinepos:=currlinepos; + oldpreprocstack:=preprocstack; + oldinputbuffer:=inputbuffer; + oldinputpointer:=inputpointer; + oldlastlinepos:=lastlinepos; + olds_point:=s_point; + oldcomment_level:=comment_level; +{$endif} + oldc:=c; oldpattern:=pattern; oldtoken:=token; oldtokenpos:=tokenpos; oldorgpattern:=orgpattern; old_block_type:=block_type; - oldpreprocstack:=preprocstack; - oldinputbuffer:=inputbuffer; - oldinputpointer:=inputpointer; - oldcurrlinepos:=currlinepos; - oldlastlinepos:=lastlinepos; - olds_point:=s_point; - oldc:=c; - oldcomment_level:=comment_level; + 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) diff --git a/compiler/pass_1.pas b/compiler/pass_1.pas index 005032686c..e17db0e836 100644 --- a/compiler/pass_1.pas +++ b/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 diff --git a/compiler/pbase.pas b/compiler/pbase.pas index 0544f541d7..e7a09ba362 100644 --- a/compiler/pbase.pas +++ b/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 diff --git a/compiler/pmodules.pas b/compiler/pmodules.pas index 9263b741dc..164c8e7352 100644 --- a/compiler/pmodules.pas +++ b/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) diff --git a/compiler/pp.pas b/compiler/pp.pas index d5f328d787..f7bf4a64da 100644 --- a/compiler/pp.pas +++ b/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 diff --git a/compiler/ra386att.pas b/compiler/ra386att.pas index 36d9cee0d4..4c31bdc2a6 100644 --- a/compiler/ra386att.pas +++ b/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 diff --git a/compiler/ra386dir.pas b/compiler/ra386dir.pas index 703b7caedc..d5a9b58efa 100644 --- a/compiler/ra386dir.pas +++ b/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 diff --git a/compiler/ra386int.pas b/compiler/ra386int.pas index 42ebf802af..6d376b874c 100644 --- a/compiler/ra386int.pas +++ b/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 diff --git a/compiler/scandir.inc b/compiler/scandir.inc index 5efb25206d..b50a718890 100644 --- a/compiler/scandir.inc +++ b/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 diff --git a/compiler/scanner.pas b/compiler/scanner.pas index 59188e9095..4f80eec9b4 100644 --- a/compiler/scanner.pas +++ b/compiler/scanner.pas @@ -28,13 +28,15 @@ unit scanner; interface uses - cobjects,globals,files; + cobjects,globals,verbose,files; const {$ifdef TP} - maxmacrolen = 1024; + maxmacrolen=1024; + InputFileBufSize=75; {$else} - maxmacrolen = 16*1024; + maxmacrolen=16*1024; + InputFileBufSize=32*1024; {$endif} id_len = 14; @@ -126,27 +128,96 @@ unit scanner; { _VIRTUAL,} _WHILE,_WITH,_XOR); - type - pmacrobuffer = ^tmacrobuffer; - tmacrobuffer = array[0..maxmacrolen-1] of char; + pmacrobuffer = ^tmacrobuffer; + tmacrobuffer = array[0..maxmacrolen-1] of char; - ppreprocstack = ^tpreprocstack; - tpreprocstack = object - isifdef, - accept : boolean; - next : ppreprocstack; - name : stringid; - line_nb : longint; - constructor init(ifdef,a:boolean;n:ppreprocstack); - destructor done; - end; + ppreprocstack = ^tpreprocstack; + tpreprocstack = object + accept : boolean; + next : ppreprocstack; + name : stringid; + line_nb : longint; + constructor init(a:boolean;n:ppreprocstack); + destructor done; + end; + +{$ifdef NEWINPUT} + pscannerfile = ^tscannerfile; + tscannerfile = object + inputfile : pinputfile; { current inputfile list } + + f : file; { current file handle } + filenotatend, { still bytes left to read } + closed : boolean; { is the file closed } + + inputbufsize : longint; { max size of the input buffer } + + inputbuffer, + inputpointer : pchar; + + bufstart, + bufidx, + bufsize : longint; + + line_no, + lasttokenpos, + lastlinepos : longint; + + s_point : boolean; + comment_level, + yylexcount : longint; + lastasmgetchar : char; + preprocstack : ppreprocstack; + + constructor init(const fn:string); + destructor done; + { File buffer things } + function open:boolean; + procedure close; + function reopen:boolean; + procedure readbuf; + procedure saveinputfile; + procedure restoreinputfile; + procedure nextfile; + procedure addfile(hp:pinputfile); + procedure reload; +{ function fixbuf:boolean; } + procedure setbuf(p:pchar;l:longint); +{ function setbufidx(idx:longint):longint; + function setlinebreak(idx:longint):longint; } + { Scanner things } + procedure gettokenpos; + procedure inc_comment_level; + procedure dec_comment_level; + procedure poppreprocstack; + procedure addpreprocstack(a:boolean;const s:string;w:tmsgconst); + procedure elsepreprocstack; + procedure linebreak; + procedure readchar; + procedure readstring; + procedure readnumber; + function readid:string; + function readval:longint; + function readcomment:string; + procedure skipspace; + procedure skipuntildirective; + procedure skipcomment; + procedure skipdelphicomment; + procedure skipoldtpcomment; + function yylex:ttoken; + function readpreproc:ttoken; + function asmgetchar:char; + end; +{$endif NEWINPUT} var c : char; orgpattern, pattern : string; - macrobuffer : pmacrobuffer; +{$ifdef NEWINPUT} + current_scanner : pscannerfile; +{$else} currlinepos, lastlinepos, lasttokenpos, @@ -158,54 +229,32 @@ unit scanner; macropos : longint; lastasmgetchar : char; preprocstack : ppreprocstack; +{$endif NEWINPUT} - {public} - procedure syntaxerror(const s : string); - function yylex : ttoken; - function asmgetchar : char; - { column position of last token } - function get_current_col : longint; - { column position of file } - function get_file_col : longint; - procedure get_cur_file_pos(var fileinfo : tfileposinfo); - procedure set_cur_file_pos(const fileinfo : tfileposinfo); +{$ifndef NEWINPUT} + procedure poppreprocstack; + procedure addpreprocstack(a:boolean;const s:string;w:tmsgconst); + procedure elsepreprocstack; + procedure gettokenpos; + function yylex : ttoken; + function asmgetchar : char; + { column position of last token } + function get_current_col : longint; + { column position of file } + function get_file_col : longint; + procedure get_cur_file_pos(var fileinfo : tfileposinfo); + procedure set_cur_file_pos(const fileinfo : tfileposinfo); + procedure InitScanner(const fn: string); + procedure DoneScanner(testendif:boolean); +{$endif} - procedure InitScanner(const fn: string); - procedure DoneScanner(testendif:boolean); + { changes to keywords to be tp compatible } + procedure change_to_tp_keywords; - { changes to keywords to be tp compatible } - procedure change_to_tp_keywords; +implementation - implementation - - uses - dos,verbose,systems,symtable,switches; - -{***************************************************************************** - TPreProcStack -*****************************************************************************} - - constructor tpreprocstack.init(ifdef,a:boolean;n:ppreprocstack); - begin - isifdef:=ifdef; - accept:=a; - next:=n; - end; - - - destructor tpreprocstack.done; - begin - end; - - - procedure popstack; - var - hp : ppreprocstack; - begin - hp:=preprocstack^.next; - dispose(preprocstack,done); - preprocstack:=hp; - end; + uses + dos,systems,symtable,switches; {***************************************************************************** Helper routines @@ -232,7 +281,7 @@ unit scanner; end else is_keyword:=false; - end; + end; procedure remove_keyword(const s : string); @@ -255,6 +304,22 @@ unit scanner; end; + procedure change_to_tp_keywords; + const + non_tp : array[0..14] of string[id_len] = ( + 'AS','CLASS','EXCEPT','FINALLY','INITIALIZATION','IS', + 'ON','OPERATOR','OTHERWISE','PROPERTY','RAISE','TRY', + 'EXPORTS','LIBRARY','FINALIZATION'); + var + i : longint; + begin + for i:=0 to 13 do + remove_keyword(non_tp[i]); + end; + + +{$ifndef NEWINPUT} + const current_column : longint = 1; @@ -286,17 +351,378 @@ unit scanner; dec(comment_level); end; - - procedure syntaxerror(const s : string); - begin - Message2(scan_f_syn_expected,tostr(get_current_col),s); - end; +{$endif NEWINPUT} {***************************************************************************** - Scanner + TPreProcStack *****************************************************************************} + constructor tpreprocstack.init(a:boolean;n:ppreprocstack); + begin + accept:=a; + next:=n; + end; + + + destructor tpreprocstack.done; + begin + end; + + + +{$ifdef NEWINPUT} + +{**************************************************************************** + TSCANNERFILE + ****************************************************************************} + + constructor tscannerfile.init(const fn:string); + begin + inputfile:=new(pinputfile,init(fn)); + current_module^.sourcefiles.register_file(inputfile); + current_module^.current_index:=inputfile^.ref_index; + { reset scanner } + preprocstack:=nil; + comment_level:=0; + s_point:=false; + block_type:=bt_general; + { reset buf } + closed:=true; + filenotatend:=true; + inputbufsize:=InputFileBufSize; + inputbuffer:=nil; + inputpointer:=nil; + bufstart:=0; + bufsize:=0; + { line } + line_no:=0; + lastlinepos:=0; + lasttokenpos:=0; + { load block } + if not open then + Message(scan_f_cannot_open_input); + status.currentsource:=inputfile^.name^; + reload; + end; + + + destructor tscannerfile.done; + begin + { check for missing ifdefs } + while assigned(preprocstack) do + begin + Message3(scan_e_endif_expected,'$IF(N)(DEF)',preprocstack^.name,tostr(preprocstack^.line_nb)); + poppreprocstack; + end; + { close file } + if not closed then + close; + end; + + + procedure tscannerfile.readbuf; + {$ifdef TP} + var + w : word; + {$endif} + begin + if closed then + exit; + inc(bufstart,bufsize); + {$ifdef TP} + blockread(f,inputbuffer^,inputbufsize-1,w); + bufsize:=w; + {$else} + blockread(f,inputbuffer^,inputbufsize-1,bufsize); + {$endif} + inputbuffer[bufsize]:=#0; + Filenotatend:=(bufsize=inputbufsize-1); + end; + + + function tscannerfile.open:boolean; + var + ofm : byte; + begin + open:=false; + if not closed then + exit; + ofm:=filemode; + filemode:=0; + Assign(f,inputfile^.path^+inputfile^.name^); + {$I-} + reset(f,1); + {$I+} + filemode:=ofm; + if ioresult<>0 then + exit; + { file } + + closed:=false; + filenotatend:=true; + Getmem(inputbuffer,inputbufsize); + inputpointer:=inputbuffer; + bufstart:=0; + bufsize:=0; + { line } + line_no:=0; + lastlinepos:=0; + lasttokenpos:=0; + open:=true; + end; + + + procedure tscannerfile.close; + var + i : word; + begin + inc(bufstart,inputpointer-inputbuffer); + if not closed then + begin + {$I-} + system.close(f); + {$I+} + i:=ioresult; + Freemem(inputbuffer,InputFileBufSize); + inputbuffer:=nil; + inputpointer:=nil; + closed:=true; + end; + end; + + + function tscannerfile.reopen:boolean; + var + ofm : byte; + begin + reopen:=false; + if not closed then + exit; + ofm:=filemode; + filemode:=0; + Assign(f,inputfile^.path^+inputfile^.name^); + {$I-} + reset(f,1); + {$I+} + filemode:=ofm; + if ioresult<>0 then + exit; + closed:=false; + { get new mem } + Getmem(inputbuffer,inputbufsize); + inputpointer:=inputbuffer; + { restore state } + seek(f,BufStart); + bufsize:=0; + readbuf; + reopen:=true; + end; + + + procedure tscannerfile.saveinputfile; + begin + inputfile^.savebufstart:=bufstart; + inputfile^.savebufsize:=bufsize; + inputfile^.savelastlinepos:=lastlinepos; + inputfile^.saveline_no:=line_no; + inputfile^.saveinputbuffer:=inputbuffer; + inputfile^.saveinputpointer:=inputpointer; + end; + + + procedure tscannerfile.restoreinputfile; + begin + bufstart:=inputfile^.savebufstart; + bufsize:=inputfile^.savebufsize; + lastlinepos:=inputfile^.savelastlinepos; + line_no:=inputfile^.saveline_no; + inputbuffer:=inputfile^.saveinputbuffer; + inputpointer:=inputfile^.saveinputpointer; + end; + + + procedure tscannerfile.nextfile; + begin + if assigned(inputfile^.next) then + begin + inputfile:=inputfile^.next; + restoreinputfile; + end; + end; + + + procedure tscannerfile.addfile(hp:pinputfile); + begin + saveinputfile; + { add to list } + hp^.next:=inputfile; + inputfile:=hp; + { load new inputfile } + restoreinputfile; + end; + + + procedure tscannerfile.reload; + begin + { still more to read, then we have an illegal char } + if (inputpointer-inputbuffer)1) then + Message1(scan_w_comment_level,tostr(comment_level)); + end; + + + procedure tscannerfile.dec_comment_level; + begin + if cs_tp_compatible in aktswitches then + comment_level:=0 + else + dec(comment_level); + end; + + + procedure tscannerfile.linebreak; + var + cur : char; + begin + if (byte(inputpointer^)=0) and + filenotatend then + begin + cur:=c; + reload; + if byte(cur)+byte(c)<>23 then + dec(longint(inputpointer)); + end + else + begin + { Fix linebreak to be only newline (=#10) for all types of linebreaks } + if (byte(inputpointer^)+byte(c)=23) then + inc(longint(inputpointer)); + end; + c:=newline; + { increase line counters } + lastlinepos:=bufstart+(inputpointer-inputbuffer); + inc(line_no); + { update for status } + inc(status.compiledlines); + Comment(V_Status,''); + end; + +{$else NEWINPUT} + + procedure gettokenpos; + { load the values of tokenpos and lasttokenpos } + begin + tokenpos.line:=current_module^.current_inputfile^.true_line; + tokenpos.column:=get_file_col; + tokenpos.fileindex:=current_module^.current_index; + end; + procedure reload; var readsize : word; @@ -363,7 +789,6 @@ unit scanner; inc(longint(inputpointer)); end; - procedure linebreak; var cur : char; @@ -383,17 +808,61 @@ unit scanner; inc(longint(inputpointer)); end; c:=newline; - { show status } + { status } Comment(V_Status,''); { increase line counters } inc(current_module^.current_inputfile^.true_line); - status.currentline:=current_module^.current_inputfile^.true_line; - inc(status.compiledlines); currlinepos:=inputpointer; + inc(status.compiledlines); + end; + +{$endif NEWINPUT} + + + procedure {$ifdef NEWINPUT}tscannerfile.{$endif}poppreprocstack; + var + hp : ppreprocstack; + begin + if assigned(preprocstack) then + begin + hp:=preprocstack^.next; + dispose(preprocstack,done); + preprocstack:=hp; + end + else + Message(scan_e_endif_without_if); end; - procedure readchar; + procedure {$ifdef NEWINPUT}tscannerfile.{$endif}addpreprocstack(a:boolean;const s:string;w:tmsgconst); + begin + preprocstack:=new(ppreprocstack,init(((preprocstack=nil) or preprocstack^.accept) and a,preprocstack)); + preprocstack^.name:=s; + preprocstack^.line_nb:={$ifndef NEWINPUT}current_module^.current_inputfile^.{$endif}line_no; + if preprocstack^.accept then + Message2(w,preprocstack^.name,'accepted') + else + Message2(w,preprocstack^.name,'rejected'); + end; + + + procedure {$ifdef NEWINPUT}tscannerfile.{$endif}elsepreprocstack; + begin + if assigned(preprocstack) then + begin + if not(assigned(preprocstack^.next)) or (preprocstack^.next^.accept) then + preprocstack^.accept:=not preprocstack^.accept; + 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); + end; + + + procedure {$ifdef NEWINPUT}tscannerfile.{$endif}readchar; begin c:=inputpointer^; if c=#0 then @@ -405,40 +874,53 @@ unit scanner; end; - function readstring:string; + procedure {$ifdef NEWINPUT}tscannerfile.{$endif}readstring; var i : longint; begin i:=0; - { 'in []' splitted, so it will be CMP's and no SET_IN_BYTE (PFV) } - while (c in ['A'..'Z','a'..'z']) or (c in ['0'..'9','_']) do - begin - if i<255 then - begin - inc(i); - readstring[i]:=c; - end; - { get next char } - c:=inputpointer^; - if c=#0 then - reload - else - inc(longint(inputpointer)); - end; - { was the next char a linebreak ? } - if c in [#10,#13] then - linebreak; - readstring[0]:=chr(i); + repeat + case c of + '_', + '0'..'9', + 'A'..'Z' : begin + if i<255 then + begin + inc(i); + orgpattern[i]:=c; + pattern[i]:=c; + end; + c:=inputpointer^; + inc(longint(inputpointer)); + end; + 'a'..'z' : begin + if i<255 then + begin + inc(i); + orgpattern[i]:=c; + pattern[i]:=chr(ord(c)-32) + end; + c:=inputpointer^; + inc(longint(inputpointer)); + end; + + #0 : reload; + #13,#10 : begin + + linebreak; + break; + end; + else + break; + end; + until false; + + orgpattern[0]:=chr(i); + pattern[0]:=chr(i); end; - function readid:string; - begin - readid:=upper(readstring); - end; - - - function readnumber:string; + procedure {$ifdef NEWINPUT}tscannerfile.{$endif}readnumber; var base, i : longint; @@ -447,13 +929,13 @@ unit scanner; '%' : begin readchar; base:=2; - readnumber[1]:='%'; + pattern[1]:='%'; i:=1; end; '$' : begin readchar; base:=16; - readnumber[1]:='$'; + pattern[1]:='$'; i:=1; end; else @@ -469,7 +951,7 @@ unit scanner; if i<255 then begin inc(i); - readnumber[i]:=c; + pattern[i]:=c; end; { get next char } c:=inputpointer^; @@ -481,20 +963,29 @@ unit scanner; { was the next char a linebreak ? } if c in [#10,#13] then linebreak; - readnumber[0]:=chr(i); + pattern[0]:=chr(i); end; - function readval:longint; + function {$ifdef NEWINPUT}tscannerfile.{$endif}readid:string; + begin + readstring; + readid:=pattern; + end; + + + function {$ifdef NEWINPUT}tscannerfile.{$endif}readval:longint; var l : longint; w : word; begin - val(readnumber,l,w); + readnumber; + valint(pattern,l,w); readval:=l; end; - function readcomment:string; + + function {$ifdef NEWINPUT}tscannerfile.{$endif}readcomment:string; var i : longint; begin @@ -528,7 +1019,7 @@ unit scanner; end; - procedure skipspace; + procedure {$ifdef NEWINPUT}tscannerfile.{$endif}skipspace; begin while c in [' ',#9..#13] do begin @@ -539,12 +1030,11 @@ unit scanner; inc(longint(inputpointer)); if c in [#10,#13] then linebreak; - end; end; - procedure skipuntildirective; + procedure {$ifdef NEWINPUT}tscannerfile.{$endif}skipuntildirective; var found : longint; begin @@ -580,7 +1070,7 @@ unit scanner; {$i scandir.inc} - procedure skipcomment; + procedure {$ifdef NEWINPUT}tscannerfile.{$endif}skipcomment; begin readchar; inc_comment_level; @@ -606,7 +1096,7 @@ unit scanner; end; - procedure skipdelphicomment; + procedure {$ifdef NEWINPUT}tscannerfile.{$endif}skipdelphicomment; begin inc_comment_level; readchar; @@ -624,7 +1114,7 @@ unit scanner; end; - procedure skipoldtpcomment; + procedure {$ifdef NEWINPUT}tscannerfile.{$endif}skipoldtpcomment; var found : longint; begin @@ -670,25 +1160,24 @@ unit scanner; end; - function yylex : ttoken; - var + function {$ifdef NEWINPUT}tscannerfile.{$endif}yylex : ttoken; + var y : ttoken; code : word; l : longint; mac : pmacrosym; hp : pinputfile; hp2 : pchar; + asciinr : string[3]; label exit_label; - begin + begin { was the last character a point ? } { this code is needed because the scanner if there is a 1. found if } { this is a floating point number or range like 1..3 } if s_point then begin - tokenpos.line:=current_module^.current_inputfile^.true_line; - tokenpos.column:=get_file_col; - tokenpos.fileindex:=current_module^.current_index; + gettokenpos; s_point:=false; if c='.' then begin @@ -711,17 +1200,19 @@ unit scanner; until false; { Save current token position } +{$ifdef NEWINPUT} + gettokenpos; + aktfilepos:=tokenpos; +{$else} + gettokenpos; lastlinepos:=currlinepos; lasttokenpos:=inputpointer; - tokenpos.line:=current_module^.current_inputfile^.true_line; - tokenpos.column:=get_file_col; - tokenpos.fileindex:=current_module^.current_index; +{$endif} { Check first for a identifier/keyword, this is 20+% faster (PFV) } if c in ['_','A'..'Z','a'..'z'] then begin - orgpattern:=readstring; - pattern:=upper(orgpattern); + readstring; if (length(pattern) in [2..id_len]) and is_keyword(y) then yylex:=y else @@ -734,9 +1225,15 @@ unit scanner; begin { don't forget the last char } dec(longint(inputpointer)); +{$ifdef NEWINPUT} + hp:=new(pinputfile,init('Macro '+pattern)); + addfile(hp); + getmem(hp2,mac^.buflen+1); + setbuf(hp2,mac^.buflen+1); +{$else} current_module^.current_inputfile^.bufpos:=inputpointer-inputbuffer; - { this isn't a proper way, but ... } hp:=new(pinputfile,init('','Macro '+pattern,'')); + { this isn't a proper way, but ... } hp^.next:=current_module^.current_inputfile; current_module^.current_inputfile:=hp; status.currentsource:=current_module^.current_inputfile^.name^; @@ -749,6 +1246,7 @@ unit scanner; getmem(hp2,mac^.buflen+1); current_module^.current_inputfile^.setbuf(hp2,mac^.buflen+1); inputbuffer:=current_module^.current_inputfile^.buf; +{$endif NEWINPUT} { copy text } move(mac^.buftext^,inputbuffer^,mac^.buflen); { put end sign } @@ -763,11 +1261,11 @@ unit scanner; inc(yylexcount); if yylexcount>16 then Message(scan_w_macro_deep_ten); -{$ifdef TP} + {$ifdef TP} yylex:=yylex; -{$else} + {$else} yylex:=yylex(); -{$endif} + {$endif} { that's all folks } dec(yylexcount); exit; @@ -781,17 +1279,17 @@ unit scanner; begin case c of '$' : begin - pattern:=readnumber; + readnumber; yylex:=INTCONST; goto exit_label; end; '%' : begin - pattern:=readnumber; + readnumber; yylex:=INTCONST; goto exit_label; end; '0'..'9' : begin - pattern:=readnumber; + readnumber; case c of '.' : begin readchar; @@ -906,13 +1404,15 @@ unit scanner; begin readchar; yylex:=_STARASN; - end else if c='*' then - begin - readchar; - yylex:=STARSTAR; end else - yylex:=STAR; + if c='*' then + begin + readchar; + yylex:=STARSTAR; + end + else + yylex:=STAR; goto exit_label; end; '/' : begin @@ -994,8 +1494,15 @@ unit scanner; case c of '#' : begin readchar; { read # } - valint(readnumber,l,code); - if (code<>0) or (l<0) or (l>255) then + asciinr:=''; + while (c in ['0'..'9']) and (length(asciinr)<3) do + begin + asciinr:=asciinr+c; + readchar; + end; + valint(asciinr,l,code); + if (asciinr='') or (code<>0) or + (l<0) or (l>255) then Message(scan_e_illegal_char_const); pattern:=pattern+chr(l); end; @@ -1088,19 +1595,93 @@ unit scanner; end; end; end; - - exit_label: - { don't change the file : too risky !! } +exit_label: + { don't change the file : too risky !! } +{$ifndef NEWINPUT} if current_module^.current_index=tokenpos.fileindex then begin current_module^.current_inputfile^.line_no:=tokenpos.line; current_module^.current_inputfile^.column:=tokenpos.column; current_column:=tokenpos.column; end; - end; +{$endif NEWINPUT} + end; - function asmgetchar : char; +{$ifdef NEWINPUT} + function tscannerfile.readpreproc:ttoken; + begin + skipspace; + case c of + 'A'..'Z', + 'a'..'z', + '_','0'..'9' : begin + preprocpat:=readid; + readpreproc:=ID; + end; + '(' : begin + readchar; + readpreproc:=LKLAMMER; + end; + ')' : begin + readchar; + readpreproc:=RKLAMMER; + end; + '+' : begin + readchar; + readpreproc:=PLUS; + end; + '-' : begin + readchar; + readpreproc:=MINUS; + end; + '*' : begin + readchar; + readpreproc:=STAR; + end; + '/' : begin + readchar; + readpreproc:=SLASH; + end; + '=' : begin + readchar; + readpreproc:=EQUAL; + end; + '>' : begin + readchar; + if c='=' then + begin + readchar; + readpreproc:=GTE; + end + else + readpreproc:=GT; + end; + '<' : begin + readchar; + case c of + '>' : begin + readchar; + readpreproc:=UNEQUAL; + end; + '=' : begin + readchar; + readpreproc:=LTE; + end; + else readpreproc:=LT; + end; + end; + #26 : Message(scan_f_end_of_file); + else + begin + readpreproc:=_EOF; + end; + end; + end; +{$endif} + + + function {$ifdef NEWINPUT}tscannerfile.{$endif}asmgetchar : char; begin if lastasmgetchar<>#0 then begin @@ -1109,14 +1690,6 @@ unit scanner; end else readchar; - { must be put in the assembler readers } - (* with tokenpos do - begin - line:=current_module^.current_inputfile^.true_line; - column:=get_file_col; - fileindex:=current_module^.current_index; - end; *) - case c of '{' : begin skipcomment; @@ -1155,6 +1728,9 @@ unit scanner; end; end; +{$ifdef NEWINPUT} + +{$else NEWPPU} procedure InitScanner(const fn: string); var @@ -1181,7 +1757,6 @@ unit scanner; end; procedure get_cur_file_pos(var fileinfo : tfileposinfo); - begin with fileinfo do begin @@ -1189,11 +1764,10 @@ unit scanner; fileindex:=current_module^.current_index; column:=get_current_col; end; - end; - procedure set_cur_file_pos(const fileinfo : tfileposinfo); + procedure set_cur_file_pos(const fileinfo : tfileposinfo); begin if current_module^.current_index<>fileinfo.fileindex then begin @@ -1210,63 +1784,29 @@ unit scanner; end; procedure DoneScanner(testendif:boolean); - var - st : string[16]; begin if (not testendif) then begin while assigned(preprocstack) do begin - if preprocstack^.isifdef then - st:='$IF(N)(DEF)' - else - st:='$ELSE'; - Message3(scan_e_endif_expected,st,preprocstack^.name,tostr(preprocstack^.line_nb)); - popstack; + Message3(scan_e_endif_expected,'$IF(N)(DEF)',preprocstack^.name,tostr(preprocstack^.line_nb)); + poppreprocstack; end; end; end; - procedure change_to_tp_keywords; - const - non_tp : array[0..14] of string[id_len] = ( - 'AS','CLASS','EXCEPT','FINALLY','INITIALIZATION','IS', - 'ON','OPERATOR','OTHERWISE','PROPERTY','RAISE','TRY', - 'EXPORTS','LIBRARY','FINALIZATION'); +{$endif NEWINPUT} - var - i : longint; - begin - for i:=0 to 13 do - remove_keyword(non_tp[i]); - end; - - procedure change_to_delphi_keywords; - - { - const - non_tp : array[0..13] of string[id_len] = ( - 'AS','CLASS','EXCEPT','FINALLY','INITIALIZATION','IS', - 'ON','OPERATOR','OTHERWISE','PROPERTY','RAISE','TRY', - 'EXPORTS','LIBRARY'); - - var - i : longint; - } - - begin - { - for i:=0 to 13 do - remove_keyword(non_tp[i]); - } - end; end. { $Log$ - Revision 1.28 1998-07-01 15:26:57 peter + Revision 1.29 1998-07-07 11:20:11 peter + + NEWINPUT for a better inputfile and scanner object + + Revision 1.28 1998/07/01 15:26:57 peter * better bufferfile.reset error handling Revision 1.27 1998/06/25 08:48:19 florian diff --git a/compiler/symdef.inc b/compiler/symdef.inc index bc7b2d39be..28ec15c686 100644 --- a/compiler/symdef.inc +++ b/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 diff --git a/compiler/symppu.inc b/compiler/symppu.inc index f4ec918252..69d2a11a6a 100644 --- a/compiler/symppu.inc +++ b/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 diff --git a/compiler/symsym.inc b/compiler/symsym.inc index e526d6946f..3e9dd1880e 100644 --- a/compiler/symsym.inc +++ b/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 diff --git a/compiler/tree.pas b/compiler/tree.pas index 07dc55c104..8bf6703bda 100644 --- a/compiler/tree.pas +++ b/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 diff --git a/compiler/verb_def.pas b/compiler/verb_def.pas index 70bf8d5ca5..0b823bd9f8 100644 --- a/compiler/verb_def.pas +++ b/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 diff --git a/compiler/verbose.pas b/compiler/verbose.pas index 40050306b5..cc23c44115 100644 --- a/compiler/verbose.pas +++ b/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