paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-02 12:31:01 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ NEWINPUT for a better inputfile and scanner object

Browse Source
This commit is contained in:
peter 1998-07-07 11:19:50 +00:00
parent 87c7b2ce06
commit 911abb5abc
20 changed files with 1439 additions and 534 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
compiler/aasm.pas
View File

@ -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

33
compiler/cgi386.pas
View File

@ -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

27
compiler/cobjects.pas
View File

@ -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

170
compiler/files.pas
View File

@ -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

89
compiler/parser.pas
View File

@ -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)

33
compiler/pass_1.pas
View File

@ -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

13
compiler/pbase.pas
View File

@ -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

35
compiler/pmodules.pas
View File

@ -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)

9
compiler/pp.pas
View File

@ -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

150
compiler/ra386att.pas
View File

@ -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

17
compiler/ra386dir.pas
View File

@ -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

87
compiler/ra386int.pas
View File

@ -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

253
compiler/scandir.inc
View File

@ -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

930
compiler/scanner.pas
View File

File diff suppressed because it is too large Load Diff

11
compiler/symdef.inc
View File

@ -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

30
compiler/symppu.inc
View File

@ -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

16
compiler/symsym.inc
View File

@ -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

9
compiler/tree.pas
View File

@ -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

24
compiler/verb_def.pas
View File

@ -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

26
compiler/verbose.pas
View File

@ -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