mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-02 03:02:38 +02:00
* released NEWINPUT
This commit is contained in:
peter
parent
20bf8f4de5
commit
1bffd4e290
@ -76,9 +76,8 @@ unit aasm;
|
||||
{ the short name makes typing easier }
|
||||
pai = ^tai;
|
||||
tai = object(tlinkedlist_item)
|
||||
typ : tait;
|
||||
line : longint;
|
||||
infile : pinputfile;
|
||||
typ : tait;
|
||||
fileinfo : tfileposinfo;
|
||||
constructor init;
|
||||
end;
|
||||
|
||||
@ -309,17 +308,7 @@ 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}
|
||||
fileinfo:=aktfilepos;
|
||||
end;
|
||||
|
||||
{****************************************************************************
|
||||
@ -843,7 +832,10 @@ uses
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.11 1998-07-07 11:19:50 peter
|
||||
Revision 1.12 1998-07-14 14:46:36 peter
|
||||
* released NEWINPUT
|
||||
|
||||
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
|
||||
|
||||
@ -53,14 +53,15 @@ unit ag68kgas;
|
||||
line_length = 70;
|
||||
|
||||
var
|
||||
{$ifdef NEWINPUT}
|
||||
infile : pinputfile;
|
||||
{$else}
|
||||
|
||||
infile : pextfile;
|
||||
{$ifdef GDB}
|
||||
n_line : byte; { different types of source lines }
|
||||
includecount : longint;
|
||||
{$endif}
|
||||
lastsec : tsection; { last section type written }
|
||||
lastsecidx,
|
||||
lastfileindex,
|
||||
lastline : longint;
|
||||
|
||||
includecount,lastline : longint;
|
||||
|
||||
function double2str(d : double) : string;
|
||||
var
|
||||
@ -211,14 +212,6 @@ unit ag68kgas;
|
||||
T68kGASASMOUTPUT
|
||||
****************************************************************************}
|
||||
|
||||
var
|
||||
{$ifdef GDB}
|
||||
n_line : byte;
|
||||
{$endif}
|
||||
lastsec : tsection;
|
||||
lastsecidx : longint;
|
||||
|
||||
|
||||
const
|
||||
ait_const2str:array[ait_const_32bit..ait_const_8bit] of string[8]=
|
||||
(#9'.long'#9,'',#9'.short'#9,#9'.byte'#9);
|
||||
@ -235,6 +228,8 @@ unit ag68kgas;
|
||||
pos,l,i : longint;
|
||||
found : boolean;
|
||||
{$ifdef GDB}
|
||||
curr_n : byte;
|
||||
infile : pinputfile;
|
||||
funcname : pchar;
|
||||
linecount : longint;
|
||||
{$endif GDB}
|
||||
@ -255,37 +250,41 @@ unit ag68kgas;
|
||||
if not (hp^.typ in [ait_external,ait_stabn,ait_stabs,
|
||||
ait_label,ait_cut,ait_align,ait_stab_function_name]) then
|
||||
begin
|
||||
{$ifdef NEWINPUT}
|
||||
if assigned(hp^.infile) and (pinputfile(hp^.infile)<>infile) then
|
||||
{$else}
|
||||
if assigned(hp^.infile) and (pextfile(hp^.infile)<>infile) then
|
||||
{$endif NEWINPUT}
|
||||
{ file changed ? (must be before line info) }
|
||||
if lastfileindex<>hp^.fileinfo.fileindex then
|
||||
begin
|
||||
infile:=hp^.infile;
|
||||
inc(includecount);
|
||||
if (hp^.infile^.path^<>'') then
|
||||
infile:=current_module^.sourcefiles.get_file(hp^.fileinfo.fileindex);
|
||||
if includecount=0 then
|
||||
curr_n:=n_sourcefile
|
||||
else
|
||||
curr_n:=n_includefile;
|
||||
if (infile^.path^<>'') then
|
||||
begin
|
||||
AsmWriteLn(#9'.stabs "'+FixPath(hp^.infile^.path^)+'",'+tostr(n_includefile)+
|
||||
',0,0,Ltext'+ToStr(IncludeCount));
|
||||
AsmWriteLn(#9'.stabs "'+lower(BsToSlash(FixPath(infile^.path^)))+'",'+
|
||||
tostr(curr_n)+',0,0,'+'Ltext'+ToStr(IncludeCount));
|
||||
end;
|
||||
AsmWriteLn(#9'.stabs "'+FixFileName(hp^.infile^.name^+hp^.infile^.ext^)+'",'+tostr(n_includefile)+
|
||||
',0,0,Ltext'+ToStr(IncludeCount));
|
||||
AsmWriteLn(#9'.stabs "'+lower(FixFileName(infile^.name^))+'",'+
|
||||
tostr(curr_n)+',0,0,'+'Ltext'+ToStr(IncludeCount));
|
||||
AsmWriteLn('Ltext'+ToStr(IncludeCount)+':');
|
||||
inc(includecount);
|
||||
lastfileindex:=hp^.fileinfo.fileindex;
|
||||
end;
|
||||
{ file name must be there before line number ! }
|
||||
if (hp^.line<>lastline) and (hp^.line<>0) then
|
||||
{ line changed ? }
|
||||
if (hp^.fileinfo.line<>lastline) and (hp^.fileinfo.line<>0) then
|
||||
begin
|
||||
if (n_line = n_textline) and assigned(funcname) and
|
||||
if (n_line=n_textline) and assigned(funcname) and
|
||||
(target_os.use_function_relative_addresses) then
|
||||
begin
|
||||
AsmWriteLn(target_asm.labelprefix+'l'+tostr(linecount)+':');
|
||||
AsmWriteLn(#9'.stabn '+tostr(n_line)+',0,'+tostr(hp^.line)+','+
|
||||
target_asm.labelprefix+'l'+tostr(linecount)+' - '+StrPas(FuncName));
|
||||
AsmWrite(#9'.stabn '+tostr(n_line)+',0,'+tostr(hp^.fileinfo.line)+','+
|
||||
target_asm.labelprefix+'l'+tostr(linecount)+' - ');
|
||||
AsmWritePChar(FuncName);
|
||||
AsmLn;
|
||||
inc(linecount);
|
||||
end
|
||||
else
|
||||
AsmWriteLn(#9'.stabd'#9+tostr(n_line)+',0,'+tostr(hp^.line));
|
||||
lastline:=hp^.line;
|
||||
AsmWriteLn(#9'.stabd'#9+tostr(n_line)+',0,'+tostr(hp^.fileinfo.line));
|
||||
lastline:=hp^.fileinfo.line;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -312,7 +311,6 @@ unit ag68kgas;
|
||||
AsmWrite('$'+tostr(pai_section(hp)^.idataidx));
|
||||
AsmLn;
|
||||
{$ifdef GDB}
|
||||
|
||||
case pai_section(hp)^.sec of
|
||||
sec_code : n_line:=n_textline;
|
||||
sec_data : n_line:=n_dataline;
|
||||
@ -555,20 +553,24 @@ ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
|
||||
end;
|
||||
|
||||
procedure tm68kgasasmlist.WriteAsmList;
|
||||
{$ifdef GDB}
|
||||
var
|
||||
p:dirstr;
|
||||
n:namestr;
|
||||
e:extstr;
|
||||
{$endif}
|
||||
begin
|
||||
{$ifdef EXTDEBUG}
|
||||
if assigned(current_module^.mainsource) then
|
||||
comment(v_info,'Start writing gas-styled assembler output for '+current_module^.mainsource^);
|
||||
{$endif}
|
||||
infile:=nil;
|
||||
includecount:=0;
|
||||
|
||||
lastline:=0;
|
||||
lastfileindex:=0;
|
||||
LastSec:=sec_none;
|
||||
{$ifdef GDB}
|
||||
includecount:=0;
|
||||
n_line:=n_bssline;
|
||||
{$endif GDB}
|
||||
|
||||
if assigned(current_module^.mainsource) then
|
||||
fsplit(current_module^.mainsource^,p,n,e)
|
||||
else
|
||||
@ -579,26 +581,6 @@ ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
|
||||
end;
|
||||
{ to get symify to work }
|
||||
AsmWriteLn(#9'.file "'+FixFileName(n+e)+'"');
|
||||
{ stabs }
|
||||
n_line:=n_bssline;
|
||||
if (cs_debuginfo in aktswitches) then
|
||||
begin
|
||||
if (p<>'') then
|
||||
AsmWriteLn(#9'.stabs "'+FixPath(p)+'",'+tostr(n_sourcefile)+',0,0,Ltext0');
|
||||
AsmWriteLn(#9'.stabs "'+FixFileName(n+e)+'",'+tostr(n_sourcefile)+',0,0,Ltext0');
|
||||
AsmWriteLn('Ltext0:');
|
||||
end;
|
||||
infile:=current_module^.sourcefiles.files;
|
||||
{ main source file is last in list }
|
||||
{$ifdef NEWINPUT}
|
||||
while assigned(infile^.next) do
|
||||
infile:=infile^.next;
|
||||
{$else}
|
||||
while assigned(infile^._next) do
|
||||
infile:=infile^._next;
|
||||
{$endif}
|
||||
lastline:=0;
|
||||
{$endif GDB}
|
||||
|
||||
{ there should be nothing but externals so we don't need to process
|
||||
WriteTree(externals); }
|
||||
@ -623,7 +605,10 @@ ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.6 1998-07-10 10:50:54 peter
|
||||
Revision 1.7 1998-07-14 14:46:38 peter
|
||||
* released NEWINPUT
|
||||
|
||||
Revision 1.6 1998/07/10 10:50:54 peter
|
||||
* m68k updates
|
||||
|
||||
Revision 1.5 1998/06/05 17:46:04 peter
|
||||
|
||||
@ -53,18 +53,16 @@ unit ag68kmit;
|
||||
const
|
||||
line_length = 70;
|
||||
|
||||
{$ifdef GDB}
|
||||
var
|
||||
{$ifdef NEWINPUT}
|
||||
infile : pinputfile;
|
||||
{$else}
|
||||
|
||||
infile : pextfile;
|
||||
{$ifdef GDB}
|
||||
n_line : byte; { different types of source lines }
|
||||
includecount : longint;
|
||||
{$endif}
|
||||
lastsec : tsection; { last section type written }
|
||||
lastsecidx,
|
||||
lastfileindex,
|
||||
lastline : longint;
|
||||
|
||||
includecount,
|
||||
lastline : longint;
|
||||
{$endif GDB}
|
||||
|
||||
function double2str(d : double) : string;
|
||||
var
|
||||
@ -251,13 +249,6 @@ unit ag68kmit;
|
||||
T68kGASASMOUTPUT
|
||||
****************************************************************************}
|
||||
|
||||
var
|
||||
{$ifdef GDB}
|
||||
n_line : byte; { different types of source lines }
|
||||
{$endif}
|
||||
lastsec : tsection; { last section type written }
|
||||
lastsecidx : longint;
|
||||
|
||||
const
|
||||
ait_const2str:array[ait_const_32bit..ait_const_8bit] of string[8]=
|
||||
(#9'.long'#9,'',#9'.short'#9,#9'.byte'#9);
|
||||
@ -274,6 +265,8 @@ unit ag68kmit;
|
||||
pos,l,i : longint;
|
||||
found : boolean;
|
||||
{$ifdef GDB}
|
||||
curr_n : byte;
|
||||
infile : pinputfile;
|
||||
funcname : pchar;
|
||||
linecount : longint;
|
||||
{$endif GDB}
|
||||
@ -294,37 +287,41 @@ unit ag68kmit;
|
||||
if not (hp^.typ in [ait_external,ait_stabn,ait_stabs,
|
||||
ait_label,ait_cut,ait_align,ait_stab_function_name]) then
|
||||
begin
|
||||
{$ifdef NEWINPUT}
|
||||
if assigned(hp^.infile) and (pinputfile(hp^.infile)<>infile) then
|
||||
{$else}
|
||||
if assigned(hp^.infile) and (pextfile(hp^.infile)<>infile) then
|
||||
{$endif NEWINPUT}
|
||||
{ file changed ? (must be before line info) }
|
||||
if lastfileindex<>hp^.fileinfo.fileindex then
|
||||
begin
|
||||
infile:=hp^.infile;
|
||||
inc(includecount);
|
||||
if (hp^.infile^.path^<>'') then
|
||||
infile:=current_module^.sourcefiles.get_file(hp^.fileinfo.fileindex);
|
||||
if includecount=0 then
|
||||
curr_n:=n_sourcefile
|
||||
else
|
||||
curr_n:=n_includefile;
|
||||
if (infile^.path^<>'') then
|
||||
begin
|
||||
AsmWriteLn(#9'.stabs "'+FixPath(hp^.infile^.path^)+'",'+tostr(n_includefile)+
|
||||
',0,0,Ltext'+ToStr(IncludeCount));
|
||||
AsmWriteLn(#9'.stabs "'+lower(BsToSlash(FixPath(infile^.path^)))+'",'+
|
||||
tostr(curr_n)+',0,0,'+'Ltext'+ToStr(IncludeCount));
|
||||
end;
|
||||
AsmWriteLn(#9'.stabs "'+FixFileName(hp^.infile^.name^+hp^.infile^.ext^)+'",'+tostr(n_includefile)+
|
||||
',0,0,Ltext'+ToStr(IncludeCount));
|
||||
AsmWriteLn(#9'.stabs "'+lower(FixFileName(infile^.name^))+'",'+
|
||||
tostr(curr_n)+',0,0,'+'Ltext'+ToStr(IncludeCount));
|
||||
AsmWriteLn('Ltext'+ToStr(IncludeCount)+':');
|
||||
inc(includecount);
|
||||
lastfileindex:=hp^.fileinfo.fileindex;
|
||||
end;
|
||||
{ file name must be there before line number ! }
|
||||
if (hp^.line<>lastline) and (hp^.line<>0) then
|
||||
{ line changed ? }
|
||||
if (hp^.fileinfo.line<>lastline) and (hp^.fileinfo.line<>0) then
|
||||
begin
|
||||
if (n_line = n_textline) and assigned(funcname) and
|
||||
if (n_line=n_textline) and assigned(funcname) and
|
||||
(target_os.use_function_relative_addresses) then
|
||||
begin
|
||||
AsmWriteLn(target_asm.labelprefix+'l'+tostr(linecount)+':');
|
||||
AsmWriteLn(#9'.stabn '+tostr(n_line)+',0,'+tostr(hp^.line)+','+
|
||||
target_asm.labelprefix+'l'+tostr(linecount)+' - '+StrPas(FuncName));
|
||||
AsmWrite(#9'.stabn '+tostr(n_line)+',0,'+tostr(hp^.fileinfo.line)+','+
|
||||
target_asm.labelprefix+'l'+tostr(linecount)+' - ');
|
||||
AsmWritePChar(FuncName);
|
||||
AsmLn;
|
||||
inc(linecount);
|
||||
end
|
||||
else
|
||||
AsmWriteLn(#9'.stabd'#9+tostr(n_line)+',0,'+tostr(hp^.line));
|
||||
lastline:=hp^.line;
|
||||
AsmWriteLn(#9'.stabd'#9+tostr(n_line)+',0,'+tostr(hp^.fileinfo.line));
|
||||
lastline:=hp^.fileinfo.line;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -592,20 +589,24 @@ ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
|
||||
end;
|
||||
|
||||
procedure tm68kmitasmlist.WriteAsmList;
|
||||
{$ifdef GDB}
|
||||
var
|
||||
p:dirstr;
|
||||
n:namestr;
|
||||
e:extstr;
|
||||
{$endif}
|
||||
begin
|
||||
{$ifdef EXTDEBUG}
|
||||
if assigned(current_module^.mainsource) then
|
||||
comment(v_info,'Start writing gas-styled assembler output for '+current_module^.mainsource^);
|
||||
{$endif}
|
||||
|
||||
lastline:=0;
|
||||
lastfileindex:=0;
|
||||
LastSec:=sec_none;
|
||||
{$ifdef GDB}
|
||||
infile:=nil;
|
||||
includecount:=0;
|
||||
n_line:=n_bssline;
|
||||
{$endif GDB}
|
||||
|
||||
if assigned(current_module^.mainsource) then
|
||||
fsplit(current_module^.mainsource^,p,n,e)
|
||||
else
|
||||
@ -616,26 +617,6 @@ ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
|
||||
end;
|
||||
{ to get symify to work }
|
||||
AsmWriteLn(#9'.file "'+FixFileName(n+e)+'"');
|
||||
{ stabs }
|
||||
n_line:=n_bssline;
|
||||
if (cs_debuginfo in aktswitches) then
|
||||
begin
|
||||
if (p<>'') then
|
||||
AsmWriteLn(#9'.stabs "'+FixPath(p)+'",'+tostr(n_sourcefile)+',0,0,Ltext0');
|
||||
AsmWriteLn(#9'.stabs "'+FixFileName(n+e)+'",'+tostr(n_sourcefile)+',0,0,Ltext0');
|
||||
AsmWriteLn('Ltext0:');
|
||||
end;
|
||||
infile:=current_module^.sourcefiles.files;
|
||||
{ main source file is last in list }
|
||||
{$ifdef NEWINPUT}
|
||||
while assigned(infile^.next) do
|
||||
infile:=infile^.next;
|
||||
{$else}
|
||||
while assigned(infile^._next) do
|
||||
infile:=infile^._next;
|
||||
{$endif}
|
||||
lastline:=0;
|
||||
{$endif GDB}
|
||||
|
||||
{ there should be nothing but externals so we don't need to process
|
||||
WriteTree(externals); }
|
||||
@ -660,7 +641,10 @@ ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.6 1998-07-10 10:50:55 peter
|
||||
Revision 1.7 1998-07-14 14:46:39 peter
|
||||
* released NEWINPUT
|
||||
|
||||
Revision 1.6 1998/07/10 10:50:55 peter
|
||||
* m68k updates
|
||||
|
||||
Revision 1.5 1998/06/05 17:46:05 peter
|
||||
|
||||
@ -485,9 +485,9 @@ Begin
|
||||
If (Reg >= R_EAX) And (Reg <= R_EDI)
|
||||
Then
|
||||
Begin
|
||||
TmpState := PPaiProp(p1^.line)^.Regs[Reg].State+1;
|
||||
FillChar(PPaiProp(p1^.line)^.Regs[Reg], SizeOf(TContent), 0);
|
||||
PPaiProp(p1^.line)^.Regs[Reg].State := TmpState;
|
||||
TmpState := PPaiProp(p1^.fileinfo.line)^.Regs[Reg].State+1;
|
||||
FillChar(PPaiProp(p1^.fileinfo.line)^.Regs[Reg], SizeOf(TContent), 0);
|
||||
PPaiProp(p1^.fileinfo.line)^.Regs[Reg].State := TmpState;
|
||||
End;
|
||||
End;
|
||||
|
||||
@ -498,11 +498,11 @@ Begin
|
||||
Counter := R_EAX;
|
||||
FindZeroReg := True;
|
||||
While (Counter <= R_EDI) And
|
||||
((PPaiProp(p^.line)^.Regs[Counter].Typ <> Con_Const) or
|
||||
(PPaiProp(p^.line)^.Regs[Counter].StartMod <> Pointer(0))) Do
|
||||
((PPaiProp(p^.fileinfo.line)^.Regs[Counter].Typ <> Con_Const) or
|
||||
(PPaiProp(p^.fileinfo.line)^.Regs[Counter].StartMod <> Pointer(0))) Do
|
||||
Inc(Byte(Counter));
|
||||
If (PPaiProp(p^.line)^.Regs[Counter].Typ = Con_Const) And
|
||||
(PPaiProp(p^.line)^.Regs[Counter].StartMod = Pointer(0))
|
||||
If (PPaiProp(p^.fileinfo.line)^.Regs[Counter].Typ = Con_Const) And
|
||||
(PPaiProp(p^.fileinfo.line)^.Regs[Counter].StartMod = Pointer(0))
|
||||
Then Result := Counter
|
||||
Else FindZeroReg := False;
|
||||
End;*)
|
||||
@ -520,7 +520,7 @@ If (Ref.base <> R_NO) Or
|
||||
Then
|
||||
{write something to a parameter or a local variable}
|
||||
For Counter := R_EAX to R_EDI Do
|
||||
With PPaiProp(p^.line)^.Regs[Counter] Do
|
||||
With PPaiProp(p^.fileinfo.line)^.Regs[Counter] Do
|
||||
Begin
|
||||
If (Counter <> WhichRegNot) And
|
||||
(typ = Con_Ref) And
|
||||
@ -534,7 +534,7 @@ If (Ref.base <> R_NO) Or
|
||||
Else
|
||||
{writing something to a pointer location}
|
||||
For Counter := R_EAX to R_EDI Do
|
||||
With PPaiProp(p^.line)^.Regs[Counter] Do
|
||||
With PPaiProp(p^.fileinfo.line)^.Regs[Counter] Do
|
||||
If (Counter <> WhichRegNot) And
|
||||
(typ = Con_Ref) And
|
||||
(Not(cs_UncertainOpts in AktSwitches) Or
|
||||
@ -552,10 +552,10 @@ If (Ref.base <> R_NO) Or
|
||||
Begin
|
||||
For Counter := R_EAX to R_EDI Do
|
||||
If (Counter <> WhichRegNot) And
|
||||
(PPaiProp(p^.line)^.Regs[Counter].typ = Con_Ref) And
|
||||
(PPaiProp(p^.fileinfo.line)^.Regs[Counter].typ = Con_Ref) And
|
||||
(Not(cs_UncertainOpts in AktSwitches) Or
|
||||
RefsEqual(Ref,
|
||||
TReference(Pai386(PPaiProp(p^.line)^.Regs[Counter].StartMod)^.op1^))) Then
|
||||
TReference(Pai386(PPaiProp(p^.fileinfo.line)^.Regs[Counter].StartMod)^.op1^))) Then
|
||||
DestroyReg(p, Counter)
|
||||
End;
|
||||
End;
|
||||
@ -577,8 +577,8 @@ Function RegsSameContent(p1, p2: Pai; Reg: TRegister): Boolean;
|
||||
Begin
|
||||
Reg := Reg32(Reg);
|
||||
RegsSameContent :=
|
||||
PPaiProp(p1^.line)^.Regs[Reg].State =
|
||||
PPaiProp(p2^.line)^.Regs[Reg].State;
|
||||
PPaiProp(p1^.fileinfo.line)^.Regs[Reg].State =
|
||||
PPaiProp(p2^.fileinfo.line)^.Regs[Reg].State;
|
||||
End;
|
||||
|
||||
Function InstructionsEqual(p1, p2: Pai): Boolean;
|
||||
@ -642,7 +642,7 @@ Begin
|
||||
Begin
|
||||
TmpP := Pai(newp^.previous);
|
||||
While Assigned (TmpP^.previous) And
|
||||
PPaiProp(TmpP^.Line)^.CanBeRemoved Do
|
||||
PPaiProp(TmpP^.fileinfo.Line)^.CanBeRemoved Do
|
||||
TmpP := Pai(TmpP^.previous);
|
||||
TmpResult := Assigned(TmpP) And
|
||||
RegsSameContent(oldp, TmpP, Reg32(TRegister(Pai386(oldp)^.op1)))
|
||||
@ -661,7 +661,7 @@ Begin
|
||||
Begin
|
||||
TmpP := Pai(newp^.previous);
|
||||
While Assigned (TmpP^.previous) And
|
||||
PPaiProp(TmpP^.Line)^.CanBeRemoved Do
|
||||
PPaiProp(TmpP^.fileinfo.Line)^.CanBeRemoved Do
|
||||
TmpP := Pai(TmpP^.previous);
|
||||
TmpResult := Assigned(TmpP) And
|
||||
RegsSameContent(oldp, TmpP, Base)
|
||||
@ -678,7 +678,7 @@ Begin
|
||||
Begin
|
||||
TmpP := Pai(newp^.previous);
|
||||
While Assigned (TmpP^.previous) And
|
||||
PPaiProp(TmpP^.Line)^.CanBeRemoved Do
|
||||
PPaiProp(TmpP^.fileinfo.Line)^.CanBeRemoved Do
|
||||
TmpP := Pai(TmpP^.previous);
|
||||
TmpResult := Assigned(TmpP) And
|
||||
RegsSameContent(oldp, TmpP, Index)
|
||||
@ -693,13 +693,13 @@ End;
|
||||
Begin {CheckSequence}
|
||||
Reg := Reg32(Reg);
|
||||
Found := 0;
|
||||
hp2 := PPaiProp(Pai(p^.previous)^.line)^.Regs[Reg].StartMod;
|
||||
hp2 := PPaiProp(Pai(p^.previous)^.fileinfo.line)^.Regs[Reg].StartMod;
|
||||
hp3 := p;
|
||||
EndMod := PPaiProp(Pai(p^.previous)^.line)^.Regs[Reg].StartMod;
|
||||
EndMod := PPaiProp(Pai(p^.previous)^.fileinfo.line)^.Regs[Reg].StartMod;
|
||||
RegsNotYetChecked := [R_EAX..R_EDI];
|
||||
For Counter := 2 to PPaiProp(Pai(p^.previous)^.line)^.Regs[Reg].NrOfMods Do
|
||||
For Counter := 2 to PPaiProp(Pai(p^.previous)^.fileinfo.line)^.Regs[Reg].NrOfMods Do
|
||||
EndMod := Pai(EndMod^.Next);
|
||||
While (Found <> PPaiProp(Pai(p^.previous)^.line)^.Regs[Reg].NrOfMods) And
|
||||
While (Found <> PPaiProp(Pai(p^.previous)^.fileinfo.line)^.Regs[Reg].NrOfMods) And
|
||||
InstructionsEqual(hp2, hp3) And
|
||||
NoChangedRegInRef(EndMod, hp3) Do
|
||||
Begin
|
||||
@ -707,10 +707,10 @@ Begin {CheckSequence}
|
||||
hp3 := Pai(hp3^.next);
|
||||
Inc(Found)
|
||||
End;
|
||||
If (Found <> PPaiProp(Pai(p^.previous)^.line)^.Regs[Reg].NrOfMods)
|
||||
If (Found <> PPaiProp(Pai(p^.previous)^.fileinfo.line)^.Regs[Reg].NrOfMods)
|
||||
Then
|
||||
Begin
|
||||
If ((Found+1) = PPaiProp(Pai(p^.previous)^.line)^.Regs[Reg].NrOfMods) And
|
||||
If ((Found+1) = PPaiProp(Pai(p^.previous)^.fileinfo.line)^.Regs[Reg].NrOfMods) And
|
||||
Assigned(hp2) And
|
||||
(Pai(hp2)^.typ = ait_instruction) And
|
||||
(Pai386(hp2)^._operator In [A_MOV, A_MOVZX]) And
|
||||
@ -743,7 +743,7 @@ Begin {CheckSequence}
|
||||
Begin
|
||||
CheckSequence := False;
|
||||
If (Found > 0) Then
|
||||
Found := PPaiProp(Pai(p)^.line)^.Regs[Reg].NrOfMods
|
||||
Found := PPaiProp(Pai(p)^.fileinfo.line)^.Regs[Reg].NrOfMods
|
||||
End
|
||||
End
|
||||
Else
|
||||
@ -760,7 +760,7 @@ Begin {CheckSequence}
|
||||
Begin
|
||||
CheckSequence := False;
|
||||
If (Found > 0) Then
|
||||
Found := PPaiProp(Pai(p)^.line)^.Regs[Reg].NrOfMods
|
||||
Found := PPaiProp(Pai(p)^.fileinfo.line)^.Regs[Reg].NrOfMods
|
||||
End
|
||||
End
|
||||
Else
|
||||
@ -775,7 +775,7 @@ Begin {CheckSequence}
|
||||
and that it was equal (otherwise CheckSequence would have returned false
|
||||
and the instruction wouldn't have been removed). If this "If found > 0"
|
||||
check is left out, incorrect optimizations are performed.}
|
||||
Found := PPaiProp(Pai(p)^.line)^.Regs[Reg].NrOfMods
|
||||
Found := PPaiProp(Pai(p)^.fileinfo.line)^.Regs[Reg].NrOfMods
|
||||
End
|
||||
End
|
||||
Else CheckSequence := True;
|
||||
@ -788,7 +788,7 @@ Var Counter: TRegister;
|
||||
Begin {initializes/desrtoys all registers}
|
||||
For Counter := R_EAX To R_EDI Do
|
||||
DestroyReg(p, Counter);
|
||||
PPaiProp(p^.line)^.DirFlag := F_Unknown;
|
||||
PPaiProp(p^.fileinfo.line)^.DirFlag := F_Unknown;
|
||||
End;
|
||||
|
||||
Procedure Destroy(PaiObj: Pai; opt: Longint; Op: Pointer);
|
||||
@ -821,10 +821,10 @@ Begin
|
||||
Then TmpProp := @PaiPropBlock^[InstrCnt]
|
||||
Else New(TmpProp);
|
||||
If (p <> First)
|
||||
Then TmpProp^ := PPaiProp(Pai(p^.previous)^.line)^
|
||||
Then TmpProp^ := PPaiProp(Pai(p^.previous)^.fileinfo.line)^
|
||||
Else FillChar(TmpProp^, SizeOf(TmpProp^), 0);
|
||||
TmpProp^.LineSave := p^.line;
|
||||
PPaiProp(p^.line) := TmpProp;
|
||||
TmpProp^.linesave := p^.fileinfo.line;
|
||||
PPaiProp(p^.fileinfo.line) := TmpProp;
|
||||
For TmpReg := R_EAX To R_EDI Do
|
||||
Inc(NrOfInstrSinceLastMod[TmpReg]);
|
||||
Case p^.typ Of
|
||||
@ -865,7 +865,7 @@ Begin
|
||||
If (RegInRef(TmpReg, TReference(Pai386(p)^.op1^)))
|
||||
Then
|
||||
Begin
|
||||
With PPaiProp(Pai(p)^.line)^.Regs[TmpReg] Do
|
||||
With PPaiProp(Pai(p)^.fileinfo.line)^.Regs[TmpReg] Do
|
||||
Begin
|
||||
Inc(State);
|
||||
{also store how many instructions are part of the sequence in the first
|
||||
@ -877,14 +877,14 @@ Begin
|
||||
StartMod := p;
|
||||
End;
|
||||
Inc(NrOfMods, NrOfInstrSinceLastMod[TmpReg]);
|
||||
PPaiProp(Pai(StartMod)^.line)^.Regs[TmpReg].NrOfMods := NrOfMods;
|
||||
PPaiProp(Pai(StartMod)^.fileinfo.line)^.Regs[TmpReg].NrOfMods := NrOfMods;
|
||||
NrOfInstrSinceLastMod[TmpReg] := 0;
|
||||
End;
|
||||
End
|
||||
Else
|
||||
Begin
|
||||
DestroyReg(p, TmpReg);
|
||||
With PPaiProp(Pai(p)^.line)^.Regs[TmpReg] Do
|
||||
With PPaiProp(Pai(p)^.fileinfo.line)^.Regs[TmpReg] Do
|
||||
Begin
|
||||
Typ := Con_Ref;
|
||||
StartMod := p;
|
||||
@ -952,8 +952,8 @@ Begin
|
||||
Case InstrProp.Ch[Cnt] Of
|
||||
C_None:;
|
||||
C_EAX..C_EDI: DestroyReg(p, TCh2Reg(InstrProp.Ch[Cnt]));
|
||||
C_CDirFlag: PPaiProp(Pai(p)^.line)^.DirFlag := F_NotSet;
|
||||
C_SDirFlag: PPaiProp(Pai(p)^.line)^.DirFlag := F_Set;
|
||||
C_CDirFlag: PPaiProp(Pai(p)^.fileinfo.line)^.DirFlag := F_NotSet;
|
||||
C_SDirFlag: PPaiProp(Pai(p)^.fileinfo.line)^.DirFlag := F_Set;
|
||||
C_Op1: Destroy(p, Pai386(p)^.op1t, Pai386(p)^.op1);
|
||||
C_Op2: Destroy(p, Pai386(p)^.op2t, Pai386(p)^.op2);
|
||||
C_Op3: Destroy(p, Pai386(p)^.op2t, Pointer(Longint(TwoWords(Pai386(p)^.op2).word2)));
|
||||
@ -998,8 +998,8 @@ Begin
|
||||
Begin
|
||||
Case Pai386(p)^._operator Of
|
||||
A_CLD: If Assigned(p^.previous) And
|
||||
(PPaiProp(Pai(p^.previous)^.line)^.DirFlag = F_NotSet) Then
|
||||
PPaiProp(Pai(p)^.line)^.CanBeRemoved := True;
|
||||
(PPaiProp(Pai(p^.previous)^.fileinfo.line)^.DirFlag = F_NotSet) Then
|
||||
PPaiProp(Pai(p)^.fileinfo.line)^.CanBeRemoved := True;
|
||||
{$IfDef OptimizeMovs}
|
||||
A_MOV, A_MOVZX, A_MOVSX:
|
||||
Begin
|
||||
@ -1011,10 +1011,11 @@ Begin
|
||||
End;}
|
||||
Top_Ref:
|
||||
Begin {destination is always a register in this case}
|
||||
With PPaiProp(p^.line)^.Regs[Reg32(Tregister(Pai386(p)^.op2))] Do
|
||||
With PPaiProp(p^.fileinfo.line)^.Regs[Reg32(Tregister(Pai386(p)^.op2))] Do
|
||||
Begin
|
||||
If Assigned(p^.previous) And
|
||||
(PPaiProp(Pai(p^.previous)^.line)^.Regs[Reg32(TRegister(Pai386(p)^.op2))].typ = con_ref) Then
|
||||
(PPaiProp(Pai(p^.previous)^.fileinfo.line)^.
|
||||
Regs[Reg32(TRegister(Pai386(p)^.op2))].typ = con_ref) Then
|
||||
{so we don't try to check a sequence when the register only contains a constant}
|
||||
If CheckSequence(p, TRegister(Pai386(p)^.op2), Cnt) And
|
||||
(Cnt > 0)
|
||||
@ -1050,7 +1051,7 @@ Begin
|
||||
If (hp1 = nil) And
|
||||
Not(RegInInstruction(Tregister(Pai386(hp2)^.op2), p))
|
||||
Then hp1 := p;
|
||||
PPaiProp(p^.line)^.CanBeRemoved := True;
|
||||
PPaiProp(p^.fileinfo.line)^.CanBeRemoved := True;
|
||||
End;
|
||||
p := Pai(p^.next);
|
||||
End;
|
||||
@ -1059,13 +1060,13 @@ Begin
|
||||
End
|
||||
Else
|
||||
If (Cnt > 0) And
|
||||
(PPaiProp(p^.line)^.CanBeRemoved) Then
|
||||
(PPaiProp(p^.fileinfo.line)^.CanBeRemoved) Then
|
||||
Begin
|
||||
hp2 := p;
|
||||
For Cnt2 := 1 to Cnt Do
|
||||
Begin
|
||||
If RegInInstruction(Tregister(Pai386(hp2)^.op2), p)
|
||||
Then PPaiProp(p^.Line)^.CanBeRemoved := False;
|
||||
Then PPaiProp(p^.fileinfo.line)^.CanBeRemoved := False;
|
||||
p := Pai(p^.Next)
|
||||
End;
|
||||
Continue;
|
||||
@ -1078,10 +1079,10 @@ Begin
|
||||
Top_Reg:
|
||||
Begin
|
||||
If Assigned(p^.previous) Then
|
||||
With PPaiProp(Pai(p^.previous)^.line)^.Regs[Reg32(TRegister(Pai386(p)^.op2))] Do
|
||||
With PPaiProp(Pai(p^.previous)^.fileinfo.line)^.Regs[Reg32(TRegister(Pai386(p)^.op2))] Do
|
||||
If (Typ = Con_Const) And
|
||||
(StartMod = Pai386(p)^.op1) Then
|
||||
PPaiProp(p^.line)^.CanBeRemoved := True;
|
||||
PPaiProp(p^.fileinfo.line)^.CanBeRemoved := True;
|
||||
End;
|
||||
Top_Ref:;
|
||||
End;
|
||||
@ -1090,17 +1091,17 @@ Begin
|
||||
End;
|
||||
{$EndIf OptimizeMovs}
|
||||
A_STD: If Assigned(p^.previous) And
|
||||
(PPaiProp(Pai(p^.previous)^.line)^.DirFlag = F_Set) Then
|
||||
PPaiProp(Pai(p)^.line)^.CanBeRemoved := True;
|
||||
(PPaiProp(Pai(p^.previous)^.fileinfo.line)^.DirFlag = F_Set) Then
|
||||
PPaiProp(Pai(p)^.fileinfo.line)^.CanBeRemoved := True;
|
||||
A_XOR:
|
||||
Begin
|
||||
If (Pai386(p)^.op1t = top_reg) And
|
||||
(Pai386(p)^.op2t = top_reg) And
|
||||
(Pai386(p)^.op1 = Pai386(p)^.op2) And
|
||||
Assigned(p^.previous) And
|
||||
(PPaiProp(Pai(p^.previous)^.line)^.Regs[Reg32(Tregister(Pai386(p)^.op1))].typ = con_const) And
|
||||
(PPaiProp(Pai(p^.previous)^.line)^.Regs[Reg32(Tregister(Pai386(p)^.op1))].StartMod = Pointer(0))
|
||||
Then PPaiProp(p^.line)^.CanBeRemoved := True
|
||||
(PPaiProp(Pai(p^.previous)^.fileinfo.line)^.Regs[Reg32(Tregister(Pai386(p)^.op1))].typ = con_const) And
|
||||
(PPaiProp(Pai(p^.previous)^.fileinfo.line)^.Regs[Reg32(Tregister(Pai386(p)^.op1))].StartMod = Pointer(0))
|
||||
Then PPaiProp(p^.fileinfo.line)^.CanBeRemoved := True
|
||||
End
|
||||
End
|
||||
End;
|
||||
@ -1118,11 +1119,11 @@ Begin
|
||||
p := First;
|
||||
InstrCnt := 1;
|
||||
While (p <> Pai(Last^.Next)) Do
|
||||
If PPaiProp(p^.line)^.CanBeRemoved
|
||||
If PPaiProp(p^.fileinfo.line)^.CanBeRemoved
|
||||
Then
|
||||
Begin
|
||||
If (InstrCnt > NrOfPaiFast) Then
|
||||
Dispose(PPaiProp(p^.Line));
|
||||
Dispose(PPaiProp(p^.fileinfo.line));
|
||||
hp1 := Pai(p^.Next);
|
||||
AsmL^.Remove(p);
|
||||
Dispose(p, Done);
|
||||
@ -1134,11 +1135,11 @@ Begin
|
||||
If (InstrCnt > NrOfPaiFast)
|
||||
Then
|
||||
Begin
|
||||
TmpLine := PPaiProp(p^.Line)^.LineSave;
|
||||
Dispose(PPaiProp(p^.Line));
|
||||
p^.Line := TmpLine;
|
||||
TmpLine := PPaiProp(p^.fileinfo.line)^.linesave;
|
||||
Dispose(PPaiProp(p^.fileinfo.line));
|
||||
p^.fileinfo.line := TmpLine;
|
||||
End
|
||||
Else p^.Line := PPaiProp(p^.Line)^.LineSave;
|
||||
Else p^.fileinfo.line := PPaiProp(p^.fileinfo.line)^.linesave;
|
||||
p := Pai(p^.Next);
|
||||
Inc(InstrCnt)
|
||||
End;
|
||||
@ -1201,7 +1202,10 @@ End;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.6 1998-05-06 08:38:33 pierre
|
||||
Revision 1.7 1998-07-14 14:46:41 peter
|
||||
* released NEWINPUT
|
||||
|
||||
Revision 1.6 1998/05/06 08:38:33 pierre
|
||||
* better position info with UseTokenInfo
|
||||
UseTokenInfo greatly simplified
|
||||
+ added check for changed tree after first time firstpass
|
||||
|
||||
@ -519,7 +519,7 @@ End;
|
||||
Then hp1 := New(Pai386, op_ref_reg(A_LEA, S_L, TmpRef, TRegister(Pai386(p)^.op2)))
|
||||
Else hp1 := New(Pai386, op_ref_reg(A_LEA, S_L, TmpRef,
|
||||
TRegister(twowords(Pai386(p)^.op2).word2)));
|
||||
hp1^.line := p^.line;
|
||||
hp1^.fileinfo := p^.fileinfo;
|
||||
InsertLLItem(p^.previous, p^.next, hp1);
|
||||
Dispose(p, Done);
|
||||
p := hp1;
|
||||
@ -536,7 +536,7 @@ End;
|
||||
Then hp1 := New(Pai386, op_ref_reg(A_LEA, S_L, TmpRef, TRegister(Pai386(p)^.op2)))
|
||||
Else hp1 := New(Pai386, op_ref_reg(A_LEA, S_L, TmpRef,
|
||||
TRegister(twowords(Pai386(p)^.op2).word2)));
|
||||
hp1^.line:= p^.line;
|
||||
hp1^.fileinfo:= p^.fileinfo;
|
||||
InsertLLItem(p^.previous, p^.next, hp1);
|
||||
Dispose(p, Done);
|
||||
p := hp1;
|
||||
@ -566,7 +566,7 @@ End;
|
||||
hp1 := New(Pai386, op_reg_reg(A_ADD, S_L,
|
||||
TRegister(Pai386(p)^.op2),TRegister(Pai386(p)^.op2)));
|
||||
End;
|
||||
hp1^.line := p^.line;
|
||||
hp1^.fileinfo := p^.fileinfo;
|
||||
InsertLLItem(p, p^.next, hp1);
|
||||
New(TmpRef);
|
||||
TmpRef^.segment := R_DEFAULT_SEG;
|
||||
@ -587,7 +587,7 @@ End;
|
||||
TmpRef^.base := TRegister(Pai386(p)^.op2);
|
||||
hp1 := New(Pai386, op_ref_reg(A_LEA, S_L, TmpRef, TRegister(Pai386(p)^.op2)));
|
||||
End;
|
||||
hp1^.line := p^.line;
|
||||
hp1^.fileinfo := p^.fileinfo;
|
||||
InsertLLItem(p^.previous, p^.next, hp1);
|
||||
Dispose(p, Done);
|
||||
p := Pai(hp1^.next);
|
||||
@ -606,7 +606,7 @@ End;
|
||||
Then hp1 := New(Pai386, op_ref_reg(A_LEA, S_L, TmpRef, TRegister(Pai386(p)^.op2)))
|
||||
Else hp1 := New(Pai386, op_ref_reg(A_LEA, S_L, TmpRef,
|
||||
TRegister(twowords(Pai386(p)^.op2).word2)));
|
||||
hp1^.line := p^.line;
|
||||
hp1^.fileinfo := p^.fileinfo;
|
||||
InsertLLItem(p^.previous, p^.next, hp1);
|
||||
Dispose(p, Done);
|
||||
p := hp1;
|
||||
@ -627,7 +627,7 @@ End;
|
||||
Tregister(twowords(Pai386(p)^.op2).word2)))
|
||||
Else hp1 := New(Pai386, op_reg_reg(A_ADD, S_L,
|
||||
TRegister(Pai386(p)^.op2), TRegister(Pai386(p)^.op2)));
|
||||
hp1^.line := p^.line;
|
||||
hp1^.fileinfo := p^.fileinfo;
|
||||
InsertLLItem(p, p^.next, hp1);
|
||||
TmpRef^.base := TRegister(Pai386(p)^.op2);
|
||||
TmpRef^.Index := TRegister(Pai386(p)^.op2);
|
||||
@ -639,7 +639,7 @@ End;
|
||||
Else
|
||||
hp1 := New(Pai386, op_ref_reg(A_LEA, S_L, TmpRef,
|
||||
TRegister(Pai386(p)^.op2)));
|
||||
hp1^.line := p^.line;
|
||||
hp1^.fileinfo := p^.fileinfo;
|
||||
InsertLLItem(p^.previous, p^.next, hp1);
|
||||
Dispose(p, Done);
|
||||
p := Pai(hp1^.next);
|
||||
@ -672,7 +672,7 @@ End;
|
||||
hp1 := New(Pai386, op_ref_reg(A_LEA, S_L, TmpRef,
|
||||
TRegister(Pai386(p)^.op2)));
|
||||
End;
|
||||
hp1^.line := p^.line;
|
||||
hp1^.fileinfo := p^.fileinfo;
|
||||
InsertLLItem(p, p^.next, hp1);
|
||||
New(TmpRef);
|
||||
TmpRef^.segment := R_DEFAULT_SEG;
|
||||
@ -695,7 +695,7 @@ End;
|
||||
hp1 := New(Pai386, op_ref_reg(A_LEA, S_L, TmpRef,
|
||||
TRegister(Pai386(p)^.op2)));
|
||||
End;
|
||||
hp1^.line := p^.line;
|
||||
hp1^.fileinfo := p^.fileinfo;
|
||||
InsertLLItem(p^.previous, p^.next, hp1);
|
||||
Dispose(p, Done);
|
||||
p := Pai(hp1^.next);
|
||||
@ -717,7 +717,7 @@ End;
|
||||
Begin
|
||||
hp1 := New(Pai386, op_reg_reg(A_MOV, S_L,PReference(Pai386(p)^.op1)^.Base,
|
||||
TRegister(Pai386(p)^.op2)));
|
||||
hp1^.line := p^.line;
|
||||
hp1^.fileinfo := p^.fileinfo;
|
||||
InsertLLItem(p^.previous,p^.next, hp1);
|
||||
Dispose(p, Done);
|
||||
p := hp1;
|
||||
@ -1125,7 +1125,7 @@ End;
|
||||
hp1 := New(Pai386, op_reg_reg(A_XOR, S_L,
|
||||
TRegister(Pai386(p)^.op2),
|
||||
TRegister(Pai386(p)^.op2)));
|
||||
hp1^.line := p^.line;
|
||||
hp1^.fileinfo := p^.fileinfo;
|
||||
InsertLLItem(p^.previous, p, hp1);
|
||||
Pai386(p)^._operator := A_MOV;
|
||||
Pai386(p)^.size := S_B;
|
||||
@ -1181,7 +1181,7 @@ End;
|
||||
Begin
|
||||
hp1 := New(Pai386,op_reg_reg(A_XOR, S_L, TRegister(Pai386(p)^.op2),
|
||||
TRegister(Pai386(p)^.op2)));
|
||||
hp1^.line := p^.line;
|
||||
hp1^.fileinfo := p^.fileinfo;
|
||||
Pai386(p)^._operator := A_MOV;
|
||||
Pai386(p)^.size := S_B;
|
||||
Pai386(p)^.op2 := Pointer(Reg32ToReg8(TRegister(Pai386(p)^.op2)));
|
||||
@ -1343,7 +1343,7 @@ End;
|
||||
End
|
||||
Else hp1 := New(Pai386, op_ref_reg(A_LEA, S_L, TmpRef,
|
||||
TRegister(Pai386(p)^.op2)));
|
||||
hp1^.line := p^.line;
|
||||
hp1^.fileinfo := p^.fileinfo;
|
||||
InsertLLItem(p^.previous, p^.next, hp1);
|
||||
Dispose(p, Done);
|
||||
p := hp1;
|
||||
@ -1361,7 +1361,7 @@ End;
|
||||
Begin
|
||||
hp1 := new(Pai386,op_reg_reg(A_ADD,Pai386(p)^.Size,
|
||||
TRegister(Pai386(p)^.op2), TRegister(Pai386(p)^.op2)));
|
||||
hp1^.line := p^.line;
|
||||
hp1^.fileinfo := p^.fileinfo;
|
||||
InsertLLItem(p^.previous, p^.next, hp1);
|
||||
Dispose(p, done);
|
||||
p := hp1;
|
||||
@ -1380,7 +1380,7 @@ End;
|
||||
TmpRef^.isintvalue := false;
|
||||
TmpRef^.offset := 0;
|
||||
hp1 := new(Pai386,op_ref_reg(A_LEA,S_L,TmpRef, TRegister(Pai386(p)^.op2)));
|
||||
hp1^.line := p^.line;
|
||||
hp1^.fileinfo := p^.fileinfo;
|
||||
InsertLLItem(p^.previous, p^.next, hp1);
|
||||
Dispose(p, done);
|
||||
p := hp1;
|
||||
@ -1631,7 +1631,10 @@ end;
|
||||
End.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.15 1998-06-16 08:56:17 peter
|
||||
Revision 1.16 1998-07-14 14:46:42 peter
|
||||
* released NEWINPUT
|
||||
|
||||
Revision 1.15 1998/06/16 08:56:17 peter
|
||||
+ targetcpu
|
||||
* cleaner pmodules for newppu
|
||||
|
||||
|
||||
@ -2486,7 +2486,7 @@ implementation
|
||||
exprasmlist^.concat(new(pai68k,op_reg(flag_2_set[hp^.location.resflags],S_B,hregister)));
|
||||
case porddef(p^.resulttype)^.typ of
|
||||
bool8bit : p^.location.register:=hregister;
|
||||
{ !!!!!!!!!!!
|
||||
{ !!!!!!!!!!!
|
||||
|
||||
bool16bit : begin
|
||||
p^.location.register:=reg8toreg16(hregister);
|
||||
@ -3563,7 +3563,7 @@ implementation
|
||||
(S_B,S_W,S_L,S_B,S_W,S_L);
|
||||
in2instr:array[in_inc_byte..in_dec_dword] of Tasmop=
|
||||
(A_ADDQ,A_ADDQ,A_ADDQ,A_SUBQ,A_SUBQ,A_SUBQ);
|
||||
{$endif}
|
||||
{$endif}
|
||||
|
||||
{ tfloattype = (f32bit,s32real,s64real,s80real,s64bit); }
|
||||
float_name: array[tfloattype] of string[8]=
|
||||
@ -4190,7 +4190,7 @@ implementation
|
||||
end;
|
||||
emitoverflowcheck(p^.left^.left);
|
||||
end;
|
||||
{$ifdef OLDINC}
|
||||
{$ifdef OLDINC}
|
||||
|
||||
in_inc_byte..in_dec_dword:
|
||||
begin
|
||||
@ -4199,7 +4199,7 @@ implementation
|
||||
in2size[p^.inlinenumber],1,newreference(p^.left^.location.reference))));
|
||||
emitoverflowcheck(p^.left);
|
||||
end;
|
||||
{$endif}
|
||||
{$endif}
|
||||
in_pred_x,
|
||||
in_succ_x:
|
||||
begin
|
||||
@ -5175,18 +5175,13 @@ end;
|
||||
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;
|
||||
aktfilepos:=p^.fileinfo;
|
||||
aktswitches:=p^.pragmas;
|
||||
if not(p^.error) then
|
||||
begin
|
||||
codegenerror:=false;
|
||||
procedures[p^.treetype](p);
|
||||
p^.error:=codegenerror;
|
||||
codegenerror:=codegenerror or oldcodegenerror;
|
||||
@ -5194,11 +5189,7 @@ end;
|
||||
else
|
||||
codegenerror:=true;
|
||||
aktswitches:=oldswitches;
|
||||
{$ifdef NEWINPUT}
|
||||
aktfilepos:=oldpos;
|
||||
{$else}
|
||||
set_cur_file_pos(oldpos);
|
||||
{$endif NEWINPUT}
|
||||
end;
|
||||
|
||||
|
||||
@ -5263,26 +5254,17 @@ end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure generatecode(var p : ptree);
|
||||
|
||||
var
|
||||
{ *pass modifies with every node aktlinenr and current_module^.current_inputfile, }
|
||||
{ to constantly contain the right line numbers }
|
||||
oldis : pinputfile;
|
||||
oldnr,i : longint;
|
||||
i : longint;
|
||||
regsize : topsize;
|
||||
regi : tregister;
|
||||
hr : preference;
|
||||
|
||||
regi : tregister;
|
||||
hr : preference;
|
||||
label
|
||||
nextreg;
|
||||
|
||||
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
|
||||
@ -5443,10 +5425,6 @@ end;
|
||||
c_usableregs:=4;
|
||||
end;
|
||||
procinfo.aktproccode^.concatlist(exprasmlist);
|
||||
{$ifndef NEWINPUT}
|
||||
current_module^.current_inputfile:=oldis;
|
||||
current_module^.current_inputfile^.line_no:=oldnr;
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
end.
|
||||
@ -5454,7 +5432,10 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.10 1998-07-10 10:50:57 peter
|
||||
Revision 1.11 1998-07-14 14:46:43 peter
|
||||
* released NEWINPUT
|
||||
|
||||
Revision 1.10 1998/07/10 10:50:57 peter
|
||||
* m68k updates
|
||||
|
||||
Revision 1.9 1998/07/06 15:51:16 michael
|
||||
|
||||
@ -235,30 +235,22 @@ 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;
|
||||
aktfilepos:=p^.fileinfo;
|
||||
aktswitches:=p^.pragmas;
|
||||
if not(p^.error) then
|
||||
begin
|
||||
codegenerror:=false;
|
||||
procedures[p^.treetype](p);
|
||||
p^.error:=codegenerror;
|
||||
codegenerror:=codegenerror or oldcodegenerror;
|
||||
end
|
||||
else
|
||||
codegenerror:=true;
|
||||
|
||||
aktswitches:=oldswitches;
|
||||
{$ifdef NEWINPUT}
|
||||
aktfilepos:=oldpos;
|
||||
{$else}
|
||||
set_cur_file_pos(oldpos);
|
||||
{$endif NEWINPUT}
|
||||
end;
|
||||
|
||||
|
||||
@ -324,26 +316,17 @@ implementation
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure generatecode(var p : ptree);
|
||||
|
||||
var
|
||||
{ *pass modifies with every node aktlinenr and current_module^.current_inputfile, }
|
||||
{ to constantly contain the right line numbers }
|
||||
oldis : pinputfile;
|
||||
oldnr,i : longint;
|
||||
i : longint;
|
||||
regsize : topsize;
|
||||
regi : tregister;
|
||||
hr : preference;
|
||||
|
||||
label
|
||||
regi : tregister;
|
||||
hr : preference;
|
||||
label
|
||||
nextreg;
|
||||
|
||||
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
|
||||
@ -514,16 +497,15 @@ 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.40 1998-07-07 11:19:52 peter
|
||||
Revision 1.41 1998-07-14 14:46:44 peter
|
||||
* released NEWINPUT
|
||||
|
||||
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
|
||||
|
||||
@ -118,7 +118,6 @@ unit cobjects;
|
||||
|
||||
{ string container }
|
||||
pstringcontainer = ^tstringcontainer;
|
||||
|
||||
tstringcontainer = object
|
||||
root,last : pstringitem;
|
||||
|
||||
@ -143,11 +142,9 @@ unit cobjects;
|
||||
procedure clear;
|
||||
end;
|
||||
|
||||
{$ifndef NEWINPUT}
|
||||
|
||||
pbufferedfile = ^tbufferedfile;
|
||||
|
||||
{$ifdef BUFFEREDFILE}
|
||||
{ this is implemented to allow buffered binary I/O }
|
||||
pbufferedfile = ^tbufferedfile;
|
||||
tbufferedfile = object
|
||||
f : file;
|
||||
buf : pchar;
|
||||
@ -236,8 +233,7 @@ unit cobjects;
|
||||
{ returns the crc }
|
||||
function getcrc : longint;
|
||||
end;
|
||||
|
||||
{$endif NEWINPUT}
|
||||
{$endif BUFFEREDFILE}
|
||||
|
||||
{ releases the string p and assignes nil to p }
|
||||
{ if p=nil then freemem isn't called }
|
||||
@ -738,7 +734,7 @@ end;
|
||||
end;
|
||||
|
||||
|
||||
{$ifndef NEWINPUT}
|
||||
{$ifdef BUFFEREDFILE}
|
||||
|
||||
{****************************************************************************
|
||||
TBUFFEREDFILE
|
||||
@ -1121,12 +1117,15 @@ end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{$endif NEWINPUT}
|
||||
{$endif BUFFEREDFILE}
|
||||
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.11 1998-07-07 11:19:54 peter
|
||||
Revision 1.12 1998-07-14 14:46:47 peter
|
||||
* released NEWINPUT
|
||||
|
||||
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
|
||||
|
||||
@ -42,7 +42,6 @@ unit files;
|
||||
{$endif}
|
||||
|
||||
type
|
||||
{$ifdef NEWINPUT}
|
||||
pinputfile = ^tinputfile;
|
||||
tinputfile = object
|
||||
path,name : pstring; { path and filename }
|
||||
@ -55,12 +54,18 @@ unit files;
|
||||
saveinputbuffer,
|
||||
saveinputpointer : pchar;
|
||||
|
||||
linebuf : plongint; { line buffer to retrieve lines }
|
||||
maxlinebuf : longint;
|
||||
|
||||
ref_count : longint; { to handle the browser refs }
|
||||
ref_index : longint;
|
||||
ref_next : pinputfile;
|
||||
|
||||
constructor init(const fn:string);
|
||||
destructor done;
|
||||
{$ifdef SourceLine}
|
||||
function getlinestr(l:longint):string;
|
||||
{$endif SourceLine}
|
||||
end;
|
||||
|
||||
pfilemanager = ^tfilemanager;
|
||||
@ -76,47 +81,6 @@ unit files;
|
||||
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 }
|
||||
pextfile = ^textfile;
|
||||
textfile = object(tbufferedfile)
|
||||
path,name,ext : pstring;
|
||||
_next : pextfile; { else conflicts with tinputstack }
|
||||
ref_index : word; { 65000 input files for a unit should be enough !! }
|
||||
{ p must be the complete path (with ending \ (or / for unix ...) }
|
||||
constructor init(const p,n,e : string);
|
||||
destructor done;virtual;
|
||||
end;
|
||||
|
||||
pinputfile = ^tinputfile;
|
||||
tinputfile = object(textfile)
|
||||
filenotatend : boolean;
|
||||
line_no : longint; { position to give out }
|
||||
true_line : longint; { real line counter }
|
||||
column : longint;
|
||||
next : pinputfile; { next input file in the stack of input files }
|
||||
ref_count : longint; { to handle the browser refs }
|
||||
constructor init(const p,n,e : string);
|
||||
procedure write_file_line(var t : text); { writes the file name and line number to t }
|
||||
function get_file_line : string;
|
||||
end;
|
||||
|
||||
pfilemanager = ^tfilemanager;
|
||||
tfilemanager = object
|
||||
files : pextfile;
|
||||
last_ref_index : word;
|
||||
constructor init;
|
||||
destructor done;
|
||||
procedure close_all;
|
||||
procedure register_file(f : pextfile);
|
||||
function get_file(w : word) : pextfile;
|
||||
end;
|
||||
|
||||
{$endif NEWINPUT}
|
||||
|
||||
type
|
||||
tunitmap = array[0..maxunits-1] of pointer;
|
||||
punitmap = ^tunitmap;
|
||||
@ -152,10 +116,9 @@ unit files;
|
||||
linkstaticlibs,
|
||||
linkofiles : tstringcontainer;
|
||||
used_units : tlinkedlist;
|
||||
{$ifndef NEWINPUT}
|
||||
current_inputfile : pinputfile;
|
||||
{$endif}
|
||||
|
||||
{ used in firstpass for faster settings }
|
||||
scanner : pointer;
|
||||
current_index : word;
|
||||
|
||||
path, { path where the module is find/created }
|
||||
@ -289,8 +252,6 @@ unit files;
|
||||
uses
|
||||
dos,verbose,systems;
|
||||
|
||||
{$ifdef NEWINPUT}
|
||||
|
||||
{****************************************************************************
|
||||
TINPUTFILE
|
||||
****************************************************************************}
|
||||
@ -303,9 +264,15 @@ unit files;
|
||||
name:=stringdup(n+e);
|
||||
path:=stringdup(p);
|
||||
next:=nil;
|
||||
{ indexing refs }
|
||||
ref_next:=nil;
|
||||
ref_count:=0;
|
||||
ref_index:=0;
|
||||
{$ifdef SourceLine}
|
||||
{ line buffer }
|
||||
linebuf:=nil;
|
||||
maxlinebuf:=0;
|
||||
{$endif SourceLine}
|
||||
end;
|
||||
|
||||
|
||||
@ -313,9 +280,50 @@ unit files;
|
||||
begin
|
||||
stringdispose(path);
|
||||
stringdispose(name);
|
||||
{$ifdef SourceLine}
|
||||
{ free memory }
|
||||
if assigned(linebuf) then
|
||||
freemem(linebuf,maxlinebuf shl 2);
|
||||
{$endif SourceLine}
|
||||
end;
|
||||
|
||||
|
||||
{$ifdef SourceLine}
|
||||
function tinputfile.getlinestr(l:longint):string;
|
||||
var
|
||||
c : char;
|
||||
i,fpos : longint;
|
||||
begin
|
||||
getlinestr:='';
|
||||
if l<maxlinebuf then
|
||||
begin
|
||||
fpos:=plongint(longint(linebuf)+line_no*2)^;
|
||||
{ in current buf ? }
|
||||
if (fpos<bufstart) or (fpos>bufstart+bufsize) then
|
||||
begin
|
||||
seekbuf(fpos);
|
||||
readbuf;
|
||||
end;
|
||||
{ the begin is in the buf now simply read until #13,#10 }
|
||||
i:=0;
|
||||
|
||||
inputpointer:=inputbuffer;
|
||||
c:=inputpointer^;
|
||||
while (i<255) and not(c in [#13,#10]) do
|
||||
begin
|
||||
inc(i);
|
||||
getlinestr[i]:=c;
|
||||
c:=inputpointer^;
|
||||
if c=#0 then
|
||||
reload
|
||||
else
|
||||
inc(longint(inputpointer));
|
||||
end;
|
||||
getlinestr[0]:=chr(i);
|
||||
end;
|
||||
end;
|
||||
{$endif SourceLine}
|
||||
|
||||
{****************************************************************************
|
||||
TFILEMANAGER
|
||||
****************************************************************************}
|
||||
@ -385,114 +393,6 @@ unit files;
|
||||
get_file_path:='';
|
||||
end;
|
||||
|
||||
{$else NEWINPUT}
|
||||
|
||||
{****************************************************************************
|
||||
TFILE
|
||||
****************************************************************************}
|
||||
|
||||
constructor textfile.init(const p,n,e : string);
|
||||
begin
|
||||
inherited init(p+n+e,extbufsize);
|
||||
path:=stringdup(p);
|
||||
name:=stringdup(n);
|
||||
ext:=stringdup(e);
|
||||
end;
|
||||
|
||||
destructor textfile.done;
|
||||
begin
|
||||
inherited done;
|
||||
end;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
TINPUTFILE
|
||||
****************************************************************************}
|
||||
|
||||
constructor tinputfile.init(const p,n,e : string);
|
||||
begin
|
||||
inherited init(p,n,e);
|
||||
filenotatend:=true;
|
||||
line_no:=1;
|
||||
true_line:=1;
|
||||
column:=1;
|
||||
next:=nil;
|
||||
end;
|
||||
|
||||
procedure tinputfile.write_file_line(var t : text);
|
||||
begin
|
||||
write(t,get_file_line);
|
||||
end;
|
||||
|
||||
|
||||
function tinputfile.get_file_line : string;
|
||||
begin
|
||||
if Use_Rhide then
|
||||
get_file_line:=lower(bstoslash(path^)+name^+ext^)+':'+tostr(line_no)+':'
|
||||
else
|
||||
get_file_line:=name^+ext^+'('+tostr(line_no)+')'
|
||||
end;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
TFILEMANAGER
|
||||
****************************************************************************}
|
||||
|
||||
constructor tfilemanager.init;
|
||||
begin
|
||||
files:=nil;
|
||||
last_ref_index:=0;
|
||||
end;
|
||||
|
||||
|
||||
destructor tfilemanager.done;
|
||||
var
|
||||
hp : pextfile;
|
||||
begin
|
||||
hp:=files;
|
||||
while assigned(hp) do
|
||||
begin
|
||||
files:=files^._next;
|
||||
dispose(hp,done);
|
||||
hp:=files;
|
||||
end;
|
||||
last_ref_index:=0;
|
||||
end;
|
||||
|
||||
|
||||
procedure tfilemanager.close_all;
|
||||
var
|
||||
hp : pextfile;
|
||||
begin
|
||||
hp:=files;
|
||||
while assigned(hp) do
|
||||
begin
|
||||
hp^.close;
|
||||
hp:=hp^._next;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure tfilemanager.register_file(f : pextfile);
|
||||
begin
|
||||
inc(last_ref_index);
|
||||
f^._next:=files;
|
||||
f^.ref_index:=last_ref_index;
|
||||
files:=f;
|
||||
end;
|
||||
|
||||
|
||||
function tfilemanager.get_file(w : word) : pextfile;
|
||||
var
|
||||
ff : pextfile;
|
||||
begin
|
||||
ff:=files;
|
||||
while assigned(ff) and (ff^.ref_index<>w) do
|
||||
ff:=ff^._next;
|
||||
get_file:=ff;
|
||||
end;
|
||||
|
||||
{$endif NEWINPUT}
|
||||
|
||||
{****************************************************************************
|
||||
TMODULE
|
||||
@ -968,9 +868,7 @@ unit files;
|
||||
linkstaticlibs.init;
|
||||
linksharedlibs.init;
|
||||
ppufile:=nil;
|
||||
{$ifndef NEWINPUT}
|
||||
current_inputfile:=nil;
|
||||
{$endif}
|
||||
scanner:=nil;
|
||||
map:=nil;
|
||||
symtable:=nil;
|
||||
flags:=0;
|
||||
@ -1105,7 +1003,10 @@ unit files;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.30 1998-07-07 11:19:55 peter
|
||||
Revision 1.31 1998-07-14 14:46:48 peter
|
||||
* released NEWINPUT
|
||||
|
||||
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
|
||||
|
||||
@ -91,58 +91,99 @@ unit parser;
|
||||
|
||||
procedure compile(const filename:string;compile_system:boolean);
|
||||
var
|
||||
{ some variables to save the compiler state }
|
||||
oldtoken : ttoken;
|
||||
oldtokenpos : tfileposinfo;
|
||||
oldpattern : stringid;
|
||||
|
||||
oldpreprocstack : ppreprocstack;
|
||||
oldorgpattern,oldprocprefix : string;
|
||||
{ scanner }
|
||||
oldtoken : ttoken;
|
||||
oldtokenpos : tfileposinfo;
|
||||
oldc : char;
|
||||
oldpattern,
|
||||
oldorgpattern : 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;
|
||||
oldc : char;
|
||||
oldcomment_level : word;
|
||||
{ symtable }
|
||||
oldmacros,
|
||||
oldrefsymtable,
|
||||
oldsymtablestack : psymtable;
|
||||
oldprocprefix : string;
|
||||
oldaktprocsym : pprocsym;
|
||||
{ cg }
|
||||
oldnextlabelnr : longint;
|
||||
oldmacros,oldrefsymtable,oldsymtablestack : psymtable;
|
||||
|
||||
oldimports,oldexports,oldresource,oldrttilist,
|
||||
oldbsssegment,olddatasegment,oldcodesegment,
|
||||
oldexprasmlist,olddebuglist,
|
||||
oldinternals,oldexternals,oldconsts : paasmoutput;
|
||||
|
||||
oldswitches : tcswitches;
|
||||
oldpackrecords : word;
|
||||
oldoutputformat : tasm;
|
||||
oldoptprocessor : tprocessors;
|
||||
oldasmmode : tasmmode;
|
||||
oldparse_only : boolean;
|
||||
{ asmlists }
|
||||
oldimports,
|
||||
oldexports,
|
||||
oldresource,
|
||||
oldrttilist,
|
||||
oldbsssegment,
|
||||
olddatasegment,
|
||||
oldcodesegment,
|
||||
oldexprasmlist,
|
||||
olddebuglist,
|
||||
oldinternals,
|
||||
oldexternals,
|
||||
oldconsts : paasmoutput;
|
||||
{ akt.. things }
|
||||
oldaktswitches : tcswitches;
|
||||
oldaktfilepos : tfileposinfo;
|
||||
oldaktpackrecords : word;
|
||||
oldaktoutputformat : tasm;
|
||||
oldaktoptprocessor : tprocessors;
|
||||
oldaktasmmode : tasmmode;
|
||||
|
||||
label
|
||||
done;
|
||||
|
||||
begin {compile}
|
||||
begin
|
||||
inc(compile_level);
|
||||
{ save old state }
|
||||
|
||||
{ save symtable state }
|
||||
{ save symtable state }
|
||||
oldsymtablestack:=symtablestack;
|
||||
symtablestack:=nil;
|
||||
oldrefsymtable:=refsymtable;
|
||||
refsymtable:=nil;
|
||||
oldmacros:=macros;
|
||||
oldprocprefix:=procprefix;
|
||||
oldaktprocsym:=aktprocsym;
|
||||
{ save scanner state }
|
||||
oldc:=c;
|
||||
oldpattern:=pattern;
|
||||
oldorgpattern:=orgpattern;
|
||||
oldtoken:=token;
|
||||
old_block_type:=block_type;
|
||||
oldtokenpos:=tokenpos;
|
||||
oldcurrent_scanner:=current_scanner;
|
||||
{ save cg }
|
||||
oldnextlabelnr:=nextlabelnr;
|
||||
oldparse_only:=parse_only;
|
||||
{ save assembler lists }
|
||||
olddatasegment:=datasegment;
|
||||
oldbsssegment:=bsssegment;
|
||||
oldcodesegment:=codesegment;
|
||||
olddebuglist:=debuglist;
|
||||
oldexternals:=externals;
|
||||
oldinternals:=internals;
|
||||
oldconsts:=consts;
|
||||
oldrttilist:=rttilist;
|
||||
oldexprasmlist:=exprasmlist;
|
||||
oldimports:=importssection;
|
||||
oldexports:=exportssection;
|
||||
oldresource:=resourcesection;
|
||||
{ save akt... state }
|
||||
oldaktswitches:=aktswitches;
|
||||
oldaktpackrecords:=aktpackrecords;
|
||||
oldaktoutputformat:=aktoutputformat;
|
||||
oldaktoptprocessor:=aktoptprocessor;
|
||||
oldaktasmmode:=aktasmmode;
|
||||
oldaktfilepos:=aktfilepos;
|
||||
|
||||
{ a long time, this was only in init_parser
|
||||
but it should be reset to zero for each module }
|
||||
{ show info }
|
||||
Message1(parser_i_compiling,filename);
|
||||
|
||||
{ reset symtable }
|
||||
symtablestack:=nil;
|
||||
refsymtable:=nil;
|
||||
procprefix:='';
|
||||
aktprocsym:=nil;
|
||||
{ macros }
|
||||
macros:=new(psymtable,init(macrosymtable));
|
||||
macros^.name:=stringdup('Conditionals for '+filename);
|
||||
default_macros;
|
||||
|
||||
{ reset the unit or create a new program }
|
||||
if assigned(current_module) then
|
||||
@ -158,80 +199,20 @@ unit parser;
|
||||
main_module:=current_module;
|
||||
end;
|
||||
|
||||
{ save scanner state }
|
||||
{$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;
|
||||
|
||||
oldmacros:=macros;
|
||||
|
||||
oldnextlabelnr:=nextlabelnr;
|
||||
oldparse_only:=parse_only;
|
||||
|
||||
{ save assembler lists }
|
||||
olddatasegment:=datasegment;
|
||||
oldbsssegment:=bsssegment;
|
||||
oldcodesegment:=codesegment;
|
||||
olddebuglist:=debuglist;
|
||||
oldexternals:=externals;
|
||||
oldinternals:=internals;
|
||||
oldconsts:=consts;
|
||||
oldrttilist:=rttilist;
|
||||
oldexprasmlist:=exprasmlist;
|
||||
oldimports:=importssection;
|
||||
oldexports:=exportssection;
|
||||
oldresource:=resourcesection;
|
||||
|
||||
{ save the current state }
|
||||
oldswitches:=aktswitches;
|
||||
oldpackrecords:=aktpackrecords;
|
||||
oldoutputformat:=aktoutputformat;
|
||||
oldoptprocessor:=aktoptprocessor;
|
||||
oldasmmode:=aktasmmode;
|
||||
|
||||
{ Load current state from the init values }
|
||||
aktswitches:=initswitches;
|
||||
aktpackrecords:=initpackrecords;
|
||||
aktoutputformat:=initoutputformat;
|
||||
aktoptprocessor:=initoptprocessor;
|
||||
aktasmmode:=initasmmode;
|
||||
|
||||
{ we need this to make the system unit }
|
||||
{ we need this to make the system unit }
|
||||
if compile_system then
|
||||
aktswitches:=aktswitches+[cs_compilesystem];
|
||||
|
||||
{ macros }
|
||||
macros:=new(psymtable,init(macrosymtable));
|
||||
macros^.name:=stringdup('Conditionals for '+filename);
|
||||
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 }
|
||||
{ global switches are read, so further changes aren't allowed }
|
||||
current_module^.in_main:=true;
|
||||
|
||||
{ init code generator for a new module }
|
||||
@ -325,67 +306,30 @@ done:
|
||||
reset_gdb_info;
|
||||
{$endif GDB}
|
||||
|
||||
{ restore symtable state }
|
||||
if (compile_level>1) then
|
||||
begin
|
||||
refsymtable:=oldrefsymtable;
|
||||
symtablestack:=oldsymtablestack;
|
||||
end;
|
||||
|
||||
procprefix:=oldprocprefix;
|
||||
|
||||
{$ifdef UseBrowser}
|
||||
{ close input files, but dont remove if we use the browser ! }
|
||||
if cs_browser in initswitches then
|
||||
current_module^.sourcefiles.close_all
|
||||
else
|
||||
current_module^.sourcefiles.done;
|
||||
{$else UseBrowser}
|
||||
{ close the inputfiles }
|
||||
current_module^.sourcefiles.done;
|
||||
{$endif not UseBrowser}
|
||||
{ free ppu }
|
||||
if assigned(current_module^.ppufile) then
|
||||
begin
|
||||
dispose(current_module^.ppufile,done);
|
||||
current_module^.ppufile:=nil;
|
||||
end;
|
||||
|
||||
{ call donescanner before restoring preprocstack, because }
|
||||
{ donescanner tests for a empty preprocstack }
|
||||
{ and can also check for unused macros }
|
||||
{$ifdef NEWINPUT}
|
||||
begin
|
||||
dispose(current_module^.ppufile,done);
|
||||
current_module^.ppufile:=nil;
|
||||
end;
|
||||
{ free scanner }
|
||||
dispose(current_scanner,done);
|
||||
{$else}
|
||||
donescanner(current_module^.compiled);
|
||||
{$endif}
|
||||
{ free macros }
|
||||
{!!! No check for unused macros yet !!! }
|
||||
dispose(macros,done);
|
||||
|
||||
{ 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;
|
||||
comment_level:=oldcomment_level;
|
||||
{$endif}
|
||||
{ restore scanner }
|
||||
c:=oldc;
|
||||
pattern:=oldpattern;
|
||||
orgpattern:=oldorgpattern;
|
||||
token:=oldtoken;
|
||||
tokenpos:=oldtokenpos;
|
||||
orgpattern:=oldorgpattern;
|
||||
block_type:=old_block_type;
|
||||
|
||||
current_scanner:=oldcurrent_scanner;
|
||||
{ restore cg }
|
||||
nextlabelnr:=oldnextlabelnr;
|
||||
parse_only:=oldparse_only;
|
||||
|
||||
macros:=oldmacros;
|
||||
|
||||
{ restore asmlists }
|
||||
{ restore asmlists }
|
||||
exprasmlist:=oldexprasmlist;
|
||||
datasegment:=olddatasegment;
|
||||
bsssegment:=oldbsssegment;
|
||||
@ -398,13 +342,22 @@ done:
|
||||
exportssection:=oldexports;
|
||||
resourcesection:=oldresource;
|
||||
rttilist:=oldrttilist;
|
||||
|
||||
{ restore current state }
|
||||
aktswitches:=oldswitches;
|
||||
aktpackrecords:=oldpackrecords;
|
||||
aktoutputformat:=oldoutputformat;
|
||||
aktoptprocessor:=oldoptprocessor;
|
||||
aktasmmode:=oldasmmode;
|
||||
{ restore symtable state }
|
||||
if (compile_level>1) then
|
||||
begin
|
||||
refsymtable:=oldrefsymtable;
|
||||
symtablestack:=oldsymtablestack;
|
||||
end;
|
||||
macros:=oldmacros;
|
||||
aktprocsym:=oldaktprocsym;
|
||||
procprefix:=oldprocprefix;
|
||||
{ restore current state }
|
||||
aktswitches:=oldaktswitches;
|
||||
aktpackrecords:=oldaktpackrecords;
|
||||
aktoutputformat:=oldaktoutputformat;
|
||||
aktoptprocessor:=oldaktoptprocessor;
|
||||
aktasmmode:=oldaktasmmode;
|
||||
aktfilepos:=oldaktfilepos;
|
||||
|
||||
{ Shut down things when the last file is compiled }
|
||||
if (compile_level=1) then
|
||||
@ -426,13 +379,17 @@ done:
|
||||
end;
|
||||
{$endif UseBrowser}
|
||||
end;
|
||||
|
||||
dec(compile_level);
|
||||
end;
|
||||
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.29 1998-07-07 11:19:59 peter
|
||||
Revision 1.30 1998-07-14 14:46:49 peter
|
||||
* released NEWINPUT
|
||||
|
||||
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
|
||||
|
||||
@ -4297,20 +4297,12 @@ 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 }
|
||||
{$ifdef NEWINPUT}
|
||||
aktfilepos:=hp^.right^.fileinfo;
|
||||
{$else}
|
||||
set_current_file_line(hp^.left);
|
||||
{$endif}
|
||||
end;
|
||||
end;
|
||||
if assigned(hp^.right) then
|
||||
@ -4979,14 +4971,8 @@ unit pass_1;
|
||||
if (p^.firstpasscount>0) and only_one_pass then
|
||||
exit;
|
||||
{$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;
|
||||
oldpos:=aktfilepos;
|
||||
oldswitches:=aktswitches;
|
||||
{$ifdef extdebug}
|
||||
if p^.firstpasscount>0 then
|
||||
@ -5001,13 +4987,8 @@ unit pass_1;
|
||||
not_first:=false;
|
||||
{$endif extdebug}
|
||||
|
||||
{$ifdef NEWINPUT}
|
||||
aktfilepos:=p^.fileinfo;
|
||||
{$else}
|
||||
set_cur_file_pos(p^.fileinfo);
|
||||
{$endif NEWINPUT}
|
||||
aktswitches:=p^.pragmas;
|
||||
|
||||
if not p^.error then
|
||||
begin
|
||||
codegenerror:=false;
|
||||
@ -5035,11 +5016,7 @@ 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;
|
||||
@ -5064,7 +5041,10 @@ unit pass_1;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.37 1998-07-07 12:31:44 peter
|
||||
Revision 1.38 1998-07-14 14:46:50 peter
|
||||
* released NEWINPUT
|
||||
|
||||
Revision 1.37 1998/07/07 12:31:44 peter
|
||||
* fixed string:= which allowed almost any type
|
||||
|
||||
Revision 1.36 1998/07/07 11:20:00 peter
|
||||
|
||||
@ -97,11 +97,7 @@ 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
|
||||
@ -155,7 +151,7 @@ unit pbase;
|
||||
begin
|
||||
if token=_END then
|
||||
last_endtoken_filepos:=tokenpos;
|
||||
token:={$ifdef NEWINPUT}current_scanner^.{$endif}yylex;
|
||||
token:=current_scanner^.yylex;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -211,13 +207,7 @@ unit pbase;
|
||||
begin
|
||||
s:=sc^.get_with_tokeninfo(filepos);
|
||||
ss:=new(pvarsym,init(s,def));
|
||||
{$ifdef NEWINPUT}
|
||||
|
||||
ss^.fileinfo:=filepos;
|
||||
{$else}
|
||||
ss^.line_no:=filepos.line;
|
||||
{$endif}
|
||||
|
||||
st^.insert(ss);
|
||||
{ static data fields are inserted in the globalsymtable }
|
||||
if (st^.symtabletype=objectsymtable) and
|
||||
@ -234,7 +224,10 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.12 1998-07-09 23:59:59 peter
|
||||
Revision 1.13 1998-07-14 14:46:52 peter
|
||||
* released NEWINPUT
|
||||
|
||||
Revision 1.12 1998/07/09 23:59:59 peter
|
||||
* fixed ttypesym bug finally
|
||||
* fileinfo in the symtable and better using for unused vars
|
||||
|
||||
|
||||
@ -188,7 +188,7 @@ unit pdecl;
|
||||
symdone : boolean;
|
||||
{ to handle absolute }
|
||||
abssym : pabsolutesym;
|
||||
{$ifdef i386}
|
||||
{$ifdef i386}
|
||||
|
||||
l : longint;
|
||||
code : word;
|
||||
@ -241,13 +241,7 @@ unit pdecl;
|
||||
abssym^.typ:=absolutesym;
|
||||
abssym^.abstyp:=tovar;
|
||||
abssym^.ref:=srsym;
|
||||
{$ifdef NEWINPUT}
|
||||
abssym^.fileinfo:=filepos;
|
||||
{$else}
|
||||
|
||||
abssym^.line_no:=filepos.line;
|
||||
{$endif}
|
||||
|
||||
symtablestack^.insert(abssym);
|
||||
end
|
||||
else
|
||||
@ -259,13 +253,7 @@ unit pdecl;
|
||||
abssym^.typ:=absolutesym;
|
||||
abssym^.abstyp:=toasm;
|
||||
abssym^.asmname:=stringdup(s);
|
||||
{$ifdef NEWINPUT}
|
||||
abssym^.fileinfo:=filepos;
|
||||
{$else}
|
||||
|
||||
abssym^.line_no:=filepos.line;
|
||||
{$endif}
|
||||
|
||||
symtablestack^.insert(abssym);
|
||||
end
|
||||
else
|
||||
@ -279,13 +267,7 @@ unit pdecl;
|
||||
abssym^.typ:=absolutesym;
|
||||
abssym^.abstyp:=toaddr;
|
||||
abssym^.absseg:=false;
|
||||
{$ifdef NEWINPUT}
|
||||
abssym^.fileinfo:=filepos;
|
||||
{$else}
|
||||
|
||||
abssym^.line_no:=filepos.line;
|
||||
{$endif}
|
||||
|
||||
s:=pattern;
|
||||
consume(INTCONST);
|
||||
val(s,abssym^.address,code);
|
||||
@ -1882,7 +1864,10 @@ unit pdecl;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.30 1998-07-10 00:00:00 peter
|
||||
Revision 1.31 1998-07-14 14:46:53 peter
|
||||
* released NEWINPUT
|
||||
|
||||
Revision 1.30 1998/07/10 00:00:00 peter
|
||||
* fixed ttypesym bug finally
|
||||
* fileinfo in the symtable and better using for unused vars
|
||||
|
||||
|
||||
@ -120,7 +120,7 @@ unit pmodules;
|
||||
datasegment^.concat(new(pai_symbol,init_global('HEAPSIZE')));
|
||||
{$endif i386}
|
||||
{$ifdef m68k}
|
||||
datasegment^.concat(new(pai_symbol,init_global('HEAP_SIZE')));
|
||||
datasegment^.concat(new(pai_symbol,init_global('HEAP_SIZE')));
|
||||
{$endif m68k}
|
||||
datasegment^.concat(new(pai_const,init_32bit(heapsize)));
|
||||
end;
|
||||
@ -259,18 +259,10 @@ 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
|
||||
@ -767,26 +759,18 @@ unit pmodules;
|
||||
if token=ID then
|
||||
begin
|
||||
{ create filenames and unit 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
|
||||
@ -1182,7 +1166,10 @@ unit pmodules;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.35 1998-07-08 12:39:38 peter
|
||||
Revision 1.36 1998-07-14 14:46:54 peter
|
||||
* released NEWINPUT
|
||||
|
||||
Revision 1.35 1998/07/08 12:39:38 peter
|
||||
* heap_size for m68k
|
||||
|
||||
Revision 1.34 1998/07/07 11:20:03 peter
|
||||
|
||||
@ -246,12 +246,7 @@ 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;
|
||||
|
||||
@ -380,10 +375,9 @@ begin
|
||||
start:=getrealtime-start;
|
||||
Message2(general_i_abslines_compiled,tostr(status.compiledlines),tostr(trunc(start))+'.'+tostr(trunc(frac(start)*10)));
|
||||
end;
|
||||
{***Obsolete
|
||||
clearnodes;
|
||||
***}
|
||||
|
||||
done_symtable;
|
||||
|
||||
{$ifdef TP}
|
||||
Comment(V_Info,'Memory: '+tostr(MemAvail)+' Bytes Free');
|
||||
{$endif}
|
||||
@ -398,7 +392,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.19 1998-07-07 11:20:04 peter
|
||||
Revision 1.20 1998-07-14 14:46:55 peter
|
||||
* released NEWINPUT
|
||||
|
||||
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
|
||||
|
||||
@ -329,10 +329,10 @@ const
|
||||
token := AS_NONE;
|
||||
{ while space and tab , continue scan... }
|
||||
while c in [' ',#9] do
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
{ Possiblities for first token in a statement: }
|
||||
{ Local Label, Label, Directive, Prefix or Opcode.... }
|
||||
{$ifdef NEWINPUT}current_scanner^.{$endif}gettokenpos;
|
||||
current_scanner^.gettokenpos;
|
||||
if firsttoken and not (c in [newline,#13,'{',';']) then
|
||||
begin
|
||||
firsttoken := FALSE;
|
||||
@ -341,11 +341,11 @@ const
|
||||
begin
|
||||
actasmpattern := c;
|
||||
{ Let us point to the next character }
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
while c in ['A'..'Z','a'..'z','0'..'9','_','$'] do
|
||||
begin
|
||||
actasmpattern := actasmpattern + c;
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
end;
|
||||
|
||||
{ this is a local label... }
|
||||
@ -356,7 +356,7 @@ const
|
||||
{ delete .L }
|
||||
delete(actasmpattern,1,2);
|
||||
{ point to next character ... }
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end
|
||||
{ must be a directive }
|
||||
@ -374,31 +374,11 @@ const
|
||||
end;
|
||||
end; { endif }
|
||||
|
||||
{$ifndef NEWINPUT}
|
||||
if c='/' then
|
||||
begin
|
||||
c:=asmgetchar;
|
||||
{ att styled comment }
|
||||
if c='/' then
|
||||
begin
|
||||
repeat
|
||||
c:=asmgetchar;
|
||||
until c=newline;
|
||||
firsttoken := TRUE;
|
||||
gettoken:=AS_SEPARATOR;
|
||||
c:=asmgetchar;
|
||||
exit;
|
||||
end
|
||||
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 := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
end;
|
||||
|
||||
if c = ':' then
|
||||
@ -410,7 +390,7 @@ const
|
||||
for labels !! (PM) }
|
||||
token := AS_LABEL;
|
||||
{ let us point to the next character }
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
gettoken := token;
|
||||
exit;
|
||||
end;
|
||||
@ -443,11 +423,11 @@ const
|
||||
{ - directive. }
|
||||
begin
|
||||
actasmpattern := c;
|
||||
c:= {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:= current_scanner^.asmgetchar;
|
||||
while c in ['A'..'Z','a'..'z','0'..'9','_','$'] do
|
||||
begin
|
||||
actasmpattern := actasmpattern + c;
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
end;
|
||||
is_asmdirective(actasmpattern,token);
|
||||
{ if directive }
|
||||
@ -464,11 +444,11 @@ const
|
||||
{ identifier, register, opcode, prefix or directive }
|
||||
'_','A'..'Z','a'..'z': begin
|
||||
actasmpattern := c;
|
||||
c:= {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:= current_scanner^.asmgetchar;
|
||||
while c in ['A'..'Z','a'..'z','0'..'9','_','$'] do
|
||||
begin
|
||||
actasmpattern := actasmpattern + c;
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
end;
|
||||
{ pascal is not case sensitive! }
|
||||
{ therefore variables which are }
|
||||
@ -503,16 +483,16 @@ const
|
||||
exit;
|
||||
end;
|
||||
'&': begin
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
gettoken := AS_AND;
|
||||
end;
|
||||
{ character }
|
||||
'''' : begin
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
if c = '\' then
|
||||
Begin
|
||||
{ escape sequence }
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
case c of
|
||||
newline: Message(scan_f_string_exceeds_line);
|
||||
't': actasmpattern:=#09;
|
||||
@ -526,8 +506,8 @@ const
|
||||
'0'..'7':
|
||||
begin
|
||||
temp:=c;
|
||||
temp:=temp+{$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
temp:=temp+{$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
temp:=temp+current_scanner^.asmgetchar;
|
||||
temp:=temp+current_scanner^.asmgetchar;
|
||||
val(octaltodec(temp),value,code);
|
||||
if (code <> 0) then
|
||||
Message1(assem_e_error_in_octal_const,temp);
|
||||
@ -536,8 +516,8 @@ const
|
||||
{ hexadecimal number }
|
||||
'x':
|
||||
begin
|
||||
temp:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
temp:=temp+{$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
temp:=current_scanner^.asmgetchar;
|
||||
temp:=temp+current_scanner^.asmgetchar;
|
||||
val(hextodec(temp),value,code);
|
||||
if (code <> 0) then
|
||||
Message1(assem_e_error_in_hex_const,temp);
|
||||
@ -554,7 +534,7 @@ const
|
||||
actasmpattern:=c;
|
||||
|
||||
gettoken := AS_STRING;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
exit;
|
||||
|
||||
end;
|
||||
@ -564,11 +544,11 @@ const
|
||||
actasmpattern:='';
|
||||
while true do
|
||||
Begin
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
case c of
|
||||
'\': Begin
|
||||
{ escape sequences }
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
case c of
|
||||
newline: Message(scan_f_string_exceeds_line);
|
||||
't': actasmpattern:=actasmpattern+#09;
|
||||
@ -582,8 +562,8 @@ const
|
||||
'0'..'7':
|
||||
begin
|
||||
temp:=c;
|
||||
temp:=temp+{$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
temp:=temp+{$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
temp:=temp+current_scanner^.asmgetchar;
|
||||
temp:=temp+current_scanner^.asmgetchar;
|
||||
val(octaltodec(temp),value,code);
|
||||
if (code <> 0) then
|
||||
Message1(assem_e_error_in_octal_const,temp);
|
||||
@ -592,8 +572,8 @@ const
|
||||
{ hexadecimal number }
|
||||
'x':
|
||||
begin
|
||||
temp:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
temp:=temp+{$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
temp:=current_scanner^.asmgetchar;
|
||||
temp:=temp+current_scanner^.asmgetchar;
|
||||
val(hextodec(temp),value,code);
|
||||
if (code <> 0) then
|
||||
Message1(assem_e_error_in_hex_const,temp);
|
||||
@ -607,7 +587,7 @@ const
|
||||
end; { end case }
|
||||
end;
|
||||
'"': begin
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
break;
|
||||
end;
|
||||
newline: Message(scan_f_string_exceeds_line);
|
||||
@ -621,91 +601,91 @@ const
|
||||
end;
|
||||
'$' : begin
|
||||
gettoken := AS_DOLLAR;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
',' : begin
|
||||
gettoken := AS_COMMA;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
'<' : begin
|
||||
gettoken := AS_SHL;
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
if c = '<' then
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
'>' : begin
|
||||
gettoken := AS_SHL;
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
if c = '>' then
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
'|' : begin
|
||||
gettoken := AS_OR;
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
'^' : begin
|
||||
gettoken := AS_XOR;
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
'!' : begin
|
||||
Message(assem_e_nor_not_supported);
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
gettoken := AS_NONE;
|
||||
exit;
|
||||
end;
|
||||
'(' : begin
|
||||
gettoken := AS_LPAREN;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
')' : begin
|
||||
gettoken := AS_RPAREN;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
':' : begin
|
||||
gettoken := AS_COLON;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
'+' : begin
|
||||
gettoken := AS_PLUS;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
'-' : begin
|
||||
gettoken := AS_MINUS;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
'*' : begin
|
||||
gettoken := AS_STAR;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
'/' : begin
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
{ att styled comment }
|
||||
if c='/' then
|
||||
begin
|
||||
repeat
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
until c=newline;
|
||||
firsttoken := TRUE;
|
||||
gettoken:=AS_SEPARATOR;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end
|
||||
else
|
||||
begin
|
||||
gettoken := AS_SLASH;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
@ -714,29 +694,29 @@ const
|
||||
{ for the moment. }
|
||||
'%' : begin
|
||||
actasmpattern := c;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
while c in ['a'..'z','A'..'Z','0'..'9'] do
|
||||
Begin
|
||||
actasmpattern := actasmpattern + c;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
end;
|
||||
token := AS_NONE;
|
||||
uppervar(actasmpattern);
|
||||
if (actasmpattern = '%ST') and (c='(') then
|
||||
Begin
|
||||
actasmpattern:=actasmpattern+c;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
if c in ['0'..'9'] then
|
||||
actasmpattern := actasmpattern + c
|
||||
else
|
||||
Message(assem_e_invalid_fpu_register);
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
if c <> ')' then
|
||||
Message(assem_e_invalid_fpu_register)
|
||||
else
|
||||
Begin
|
||||
actasmpattern := actasmpattern + c;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar; { let us point to next character. }
|
||||
c:=current_scanner^.asmgetchar; { let us point to next character. }
|
||||
end;
|
||||
end;
|
||||
is_register(actasmpattern, token);
|
||||
@ -752,11 +732,11 @@ const
|
||||
{ integer number }
|
||||
'1'..'9': begin
|
||||
actasmpattern := c;
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
while c in ['0'..'9'] do
|
||||
Begin
|
||||
actasmpattern := actasmpattern + c;
|
||||
c:= {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:= current_scanner^.asmgetchar;
|
||||
end;
|
||||
gettoken := AS_INTNUM;
|
||||
exit;
|
||||
@ -764,57 +744,57 @@ const
|
||||
'0': begin
|
||||
{ octal,hexa,real or binary number. }
|
||||
actasmpattern := c;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
case upcase(c) of
|
||||
{ binary }
|
||||
'B': Begin
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
while c in ['0','1'] do
|
||||
Begin
|
||||
actasmpattern := actasmpattern + c;
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
end;
|
||||
gettoken := AS_BINNUM;
|
||||
exit;
|
||||
end;
|
||||
{ real }
|
||||
'D': Begin
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
{ get ridd of the 0d }
|
||||
if (c='+') or (c='-') then
|
||||
begin
|
||||
actasmpattern:=c;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
end
|
||||
else
|
||||
actasmpattern:='';
|
||||
while c in ['0'..'9'] do
|
||||
Begin
|
||||
actasmpattern := actasmpattern + c;
|
||||
c:= {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:= current_scanner^.asmgetchar;
|
||||
end;
|
||||
if c='.' then
|
||||
begin
|
||||
actasmpattern := actasmpattern + c;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
while c in ['0'..'9'] do
|
||||
Begin
|
||||
actasmpattern := actasmpattern + c;
|
||||
c:= {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:= current_scanner^.asmgetchar;
|
||||
end;
|
||||
if upcase(c) = 'E' then
|
||||
begin
|
||||
actasmpattern := actasmpattern + c;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
if (c = '+') or (c = '-') then
|
||||
begin
|
||||
actasmpattern := actasmpattern + c;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
end;
|
||||
while c in ['0'..'9'] do
|
||||
Begin
|
||||
actasmpattern := actasmpattern + c;
|
||||
c:= {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:= current_scanner^.asmgetchar;
|
||||
end;
|
||||
end;
|
||||
gettoken := AS_REALNUM;
|
||||
@ -825,11 +805,11 @@ const
|
||||
end;
|
||||
{ hexadecimal }
|
||||
'X': Begin
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
while c in ['0'..'9','a'..'f','A'..'F'] do
|
||||
Begin
|
||||
actasmpattern := actasmpattern + c;
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
end;
|
||||
gettoken := AS_HEXNUM;
|
||||
exit;
|
||||
@ -840,7 +820,7 @@ const
|
||||
while c in ['0'..'7'] do
|
||||
Begin
|
||||
actasmpattern := actasmpattern + c;
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
end;
|
||||
gettoken := AS_OCTALNUM;
|
||||
exit;
|
||||
@ -854,7 +834,7 @@ const
|
||||
end;
|
||||
'{',#13,newline,';' : begin
|
||||
{ the comment is read by asmgetchar }
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
firsttoken := TRUE;
|
||||
gettoken:=AS_SEPARATOR;
|
||||
end;
|
||||
@ -3419,7 +3399,7 @@ const
|
||||
store_p:=p;
|
||||
{ setup label linked list }
|
||||
labellist.init;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
actasmtoken:=gettoken;
|
||||
while actasmtoken<>AS_END do
|
||||
Begin
|
||||
@ -3695,7 +3675,10 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.4 1998-07-08 15:06:41 daniel
|
||||
Revision 1.5 1998-07-14 14:46:58 peter
|
||||
* released NEWINPUT
|
||||
|
||||
Revision 1.4 1998/07/08 15:06:41 daniel
|
||||
+ $N+,E+ added for TP.
|
||||
|
||||
Revision 1.3 1998/07/07 11:20:07 peter
|
||||
|
||||
@ -73,11 +73,11 @@ unit Ra386dir;
|
||||
retstr:=upper(tostr(procinfo.retoffset)+'('+att_reg2str[procinfo.framepointer]+')')
|
||||
else
|
||||
retstr:='';
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
code:=new(paasmoutput,init);
|
||||
while not(ende) do
|
||||
begin
|
||||
{$ifdef NEWINPUT}current_scanner^.{$endif}gettokenpos;
|
||||
current_scanner^.gettokenpos;
|
||||
case c of
|
||||
'A'..'Z','a'..'z','_' : begin
|
||||
hs:='';
|
||||
@ -88,7 +88,7 @@ unit Ra386dir;
|
||||
begin
|
||||
inc(byte(hs[0]));
|
||||
hs[length(hs)]:=c;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
end;
|
||||
if upper(hs)='END' then
|
||||
ende:=true
|
||||
@ -219,14 +219,14 @@ unit Ra386dir;
|
||||
if pos(retstr,s) > 0 then
|
||||
procinfo.funcret_is_valid:=true;
|
||||
writeasmline;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
end;
|
||||
#26 : Message(scan_f_end_of_file);
|
||||
else
|
||||
begin
|
||||
inc(byte(s[0]));
|
||||
s[length(s)]:=c;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -237,7 +237,10 @@ unit Ra386dir;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.3 1998-07-07 11:20:08 peter
|
||||
Revision 1.4 1998-07-14 14:46:59 peter
|
||||
* released NEWINPUT
|
||||
|
||||
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
|
||||
|
||||
@ -332,10 +332,10 @@ var
|
||||
token := AS_NONE;
|
||||
{ while space and tab , continue scan... }
|
||||
while (c in [' ',#9]) do
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
{ Possiblities for first token in a statement: }
|
||||
{ Local Label, Label, Directive, Prefix or Opcode.... }
|
||||
{$ifdef NEWINPUT}current_scanner^.{$endif}gettokenpos;
|
||||
current_scanner^.gettokenpos;
|
||||
if firsttoken and not (c in [newline,#13,'{',';']) then
|
||||
begin
|
||||
firsttoken := FALSE;
|
||||
@ -343,7 +343,7 @@ var
|
||||
begin
|
||||
token := AS_LLABEL; { this is a local label }
|
||||
{ Let us point to the next character }
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
end;
|
||||
|
||||
|
||||
@ -353,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 := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
end;
|
||||
|
||||
uppervar(actasmpattern);
|
||||
@ -365,7 +365,7 @@ var
|
||||
AS_LLABEL: ; { do nothing }
|
||||
end; { end case }
|
||||
{ let us point to the next character }
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
gettoken := token;
|
||||
exit;
|
||||
end;
|
||||
@ -404,11 +404,11 @@ var
|
||||
{ - @Result, @Code or @Data special variables. }
|
||||
begin
|
||||
actasmpattern := c;
|
||||
c:= {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:= current_scanner^.asmgetchar;
|
||||
while c in ['A'..'Z','a'..'z','0'..'9','_','@'] do
|
||||
begin
|
||||
actasmpattern := actasmpattern + c;
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
end;
|
||||
uppervar(actasmpattern);
|
||||
gettoken := AS_ID;
|
||||
@ -417,11 +417,11 @@ var
|
||||
{ identifier, register, opcode, prefix or directive }
|
||||
'A'..'Z','a'..'z','_': begin
|
||||
actasmpattern := c;
|
||||
c:= {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:= current_scanner^.asmgetchar;
|
||||
while c in ['A'..'Z','a'..'z','0'..'9','_'] do
|
||||
begin
|
||||
actasmpattern := actasmpattern + c;
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
end;
|
||||
uppervar(actasmpattern);
|
||||
|
||||
@ -452,7 +452,7 @@ var
|
||||
{ override operator... not supported }
|
||||
'&': begin
|
||||
Message(assem_w_override_op_not_supported);
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
gettoken := AS_NONE;
|
||||
end;
|
||||
{ string or character }
|
||||
@ -463,7 +463,7 @@ var
|
||||
begin
|
||||
if c = '''' then
|
||||
begin
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
if c=newline then
|
||||
begin
|
||||
Message(scan_f_string_exceeds_line);
|
||||
@ -472,11 +472,11 @@ var
|
||||
repeat
|
||||
if c=''''then
|
||||
begin
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
if c='''' then
|
||||
begin
|
||||
actasmpattern:=actasmpattern+'''';
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
if c=newline then
|
||||
begin
|
||||
Message(scan_f_string_exceeds_line);
|
||||
@ -488,7 +488,7 @@ var
|
||||
else
|
||||
begin
|
||||
actasmpattern:=actasmpattern+c;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
if c=newline then
|
||||
begin
|
||||
Message(scan_f_string_exceeds_line);
|
||||
@ -511,7 +511,7 @@ var
|
||||
begin
|
||||
if c = '"' then
|
||||
begin
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
if c=newline then
|
||||
begin
|
||||
Message(scan_f_string_exceeds_line);
|
||||
@ -520,11 +520,11 @@ var
|
||||
repeat
|
||||
if c='"'then
|
||||
begin
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
if c='"' then
|
||||
begin
|
||||
actasmpattern:=actasmpattern+'"';
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
if c=newline then
|
||||
begin
|
||||
Message(scan_f_string_exceeds_line);
|
||||
@ -537,7 +537,7 @@ var
|
||||
else
|
||||
begin
|
||||
actasmpattern:=actasmpattern+c;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
if c=newline then
|
||||
begin
|
||||
Message(scan_f_string_exceeds_line);
|
||||
@ -553,68 +553,68 @@ var
|
||||
exit;
|
||||
end;
|
||||
'$' : begin
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
while c in ['0'..'9','A'..'F','a'..'f'] do
|
||||
begin
|
||||
actasmpattern := actasmpattern + c;
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
end;
|
||||
gettoken := AS_HEXNUM;
|
||||
exit;
|
||||
end;
|
||||
',' : begin
|
||||
gettoken := AS_COMMA;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
'[' : begin
|
||||
gettoken := AS_LBRACKET;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
']' : begin
|
||||
gettoken := AS_RBRACKET;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
'(' : begin
|
||||
gettoken := AS_LPAREN;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
')' : begin
|
||||
gettoken := AS_RPAREN;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
':' : begin
|
||||
gettoken := AS_COLON;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
'.' : begin
|
||||
gettoken := AS_DOT;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
'+' : begin
|
||||
gettoken := AS_PLUS;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
'-' : begin
|
||||
gettoken := AS_MINUS;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
'*' : begin
|
||||
gettoken := AS_STAR;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
'/' : begin
|
||||
gettoken := AS_SLASH;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
'0'..'9': begin
|
||||
@ -622,12 +622,12 @@ var
|
||||
{ if so, then we use a default value instead.}
|
||||
errorflag := false;
|
||||
actasmpattern := c;
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
{ Get the possible characters }
|
||||
while c in ['0'..'9','A'..'F','a'..'f'] do
|
||||
begin
|
||||
actasmpattern := actasmpattern + c;
|
||||
c:= {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:= current_scanner^.asmgetchar;
|
||||
end;
|
||||
{ Get ending character }
|
||||
uppervar(actasmpattern);
|
||||
@ -663,7 +663,7 @@ var
|
||||
if errorflag then
|
||||
actasmpattern := '0';
|
||||
gettoken := AS_OCTALNUM;
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
'H': Begin
|
||||
@ -677,7 +677,7 @@ var
|
||||
if errorflag then
|
||||
actasmpattern := '0';
|
||||
gettoken := AS_HEXNUM;
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
else { must be an integer number }
|
||||
@ -698,7 +698,7 @@ var
|
||||
end; { end if }
|
||||
end;
|
||||
';','{',#13,newline : begin
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
firsttoken := TRUE;
|
||||
gettoken:=AS_SEPARATOR;
|
||||
end;
|
||||
@ -3253,7 +3253,7 @@ var
|
||||
p:=new(paasmoutput,init);
|
||||
{ setup label linked list }
|
||||
labellist.init;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
actasmtoken:=gettoken;
|
||||
while actasmtoken<>AS_END do
|
||||
Begin
|
||||
@ -3368,7 +3368,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.3 1998-07-07 11:20:09 peter
|
||||
Revision 1.4 1998-07-14 14:47:00 peter
|
||||
* released NEWINPUT
|
||||
|
||||
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
|
||||
|
||||
@ -237,8 +237,8 @@ var
|
||||
token := AS_NONE;
|
||||
{ while space and tab , continue scan... }
|
||||
while c in [' ',#9] do
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
{$ifdef NEWINPUT}current_scanner^.{$endif}gettokenpos;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
current_scanner^.gettokenpos;
|
||||
{ Possiblities for first token in a statement: }
|
||||
{ Local Label, Label, Directive, Prefix or Opcode.... }
|
||||
if firsttoken and not (c in [newline,#13,'{',';']) then
|
||||
@ -249,7 +249,7 @@ var
|
||||
begin
|
||||
token := AS_LLABEL; { this is a local label }
|
||||
{ Let us point to the next character }
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
end;
|
||||
|
||||
|
||||
@ -259,7 +259,7 @@ var
|
||||
{ if there is an at_sign, then this must absolutely be a label }
|
||||
if c = '@' then forcelabel:=TRUE;
|
||||
actasmpattern := actasmpattern + c;
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
end;
|
||||
|
||||
uppervar(actasmpattern);
|
||||
@ -271,7 +271,7 @@ var
|
||||
AS_LLABEL: ; { do nothing }
|
||||
end; { end case }
|
||||
{ let us point to the next character }
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
gettoken := token;
|
||||
exit;
|
||||
end;
|
||||
@ -307,11 +307,11 @@ var
|
||||
{ - @Result, @Code or @Data special variables. }
|
||||
begin
|
||||
actasmpattern := c;
|
||||
c:= {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:= current_scanner^.asmgetchar;
|
||||
while c in ['A'..'Z','a'..'z','0'..'9','_','@','.'] do
|
||||
begin
|
||||
actasmpattern := actasmpattern + c;
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
end;
|
||||
uppervar(actasmpattern);
|
||||
gettoken := AS_ID;
|
||||
@ -320,11 +320,11 @@ var
|
||||
{ identifier, register, opcode, prefix or directive }
|
||||
'A'..'Z','a'..'z','_': begin
|
||||
actasmpattern := c;
|
||||
c:= {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:= current_scanner^.asmgetchar;
|
||||
while c in ['A'..'Z','a'..'z','0'..'9','_','.'] do
|
||||
begin
|
||||
actasmpattern := actasmpattern + c;
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
end;
|
||||
uppervar(actasmpattern);
|
||||
|
||||
@ -350,7 +350,7 @@ var
|
||||
end;
|
||||
{ override operator... not supported }
|
||||
'&': begin
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
gettoken := AS_AND;
|
||||
end;
|
||||
{ string or character }
|
||||
@ -361,7 +361,7 @@ var
|
||||
begin
|
||||
if c = '''' then
|
||||
begin
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
if c=newline then
|
||||
begin
|
||||
Message(scan_f_string_exceeds_line);
|
||||
@ -370,11 +370,11 @@ var
|
||||
repeat
|
||||
if c=''''then
|
||||
begin
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
if c='''' then
|
||||
begin
|
||||
actasmpattern:=actasmpattern+'''';
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
if c=newline then
|
||||
begin
|
||||
Message(scan_f_string_exceeds_line);
|
||||
@ -386,7 +386,7 @@ var
|
||||
else
|
||||
begin
|
||||
actasmpattern:=actasmpattern+c;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
if c=newline then
|
||||
begin
|
||||
Message(scan_f_string_exceeds_line);
|
||||
@ -402,101 +402,101 @@ var
|
||||
exit;
|
||||
end;
|
||||
'$' : begin
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
while c in ['0'..'9','A'..'F','a'..'f'] do
|
||||
begin
|
||||
actasmpattern := actasmpattern + c;
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
end;
|
||||
gettoken := AS_HEXNUM;
|
||||
exit;
|
||||
end;
|
||||
',' : begin
|
||||
gettoken := AS_COMMA;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
'(' : begin
|
||||
gettoken := AS_LPAREN;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
')' : begin
|
||||
gettoken := AS_RPAREN;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
':' : begin
|
||||
gettoken := AS_COLON;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
{ '.' : begin
|
||||
gettoken := AS_DOT;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end; }
|
||||
'+' : begin
|
||||
gettoken := AS_PLUS;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
'-' : begin
|
||||
gettoken := AS_MINUS;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
'*' : begin
|
||||
gettoken := AS_STAR;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
'/' : begin
|
||||
gettoken := AS_SLASH;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
'<' : begin
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
{ invalid characters }
|
||||
if c <> '<' then
|
||||
Message(assem_e_invalid_char_smaller);
|
||||
{ still assume << }
|
||||
gettoken := AS_SHL;
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
'>' : begin
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
{ invalid characters }
|
||||
if c <> '>' then
|
||||
Message(assem_e_invalid_char_greater);
|
||||
{ still assume << }
|
||||
gettoken := AS_SHR;
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
'|' : begin
|
||||
gettoken := AS_OR;
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
'^' : begin
|
||||
gettoken := AS_XOR;
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
'#' : begin
|
||||
gettoken:=AS_APPT;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
exit;
|
||||
end;
|
||||
'%' : begin
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
while c in ['0','1'] do
|
||||
Begin
|
||||
actasmpattern := actasmpattern + c;
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
end;
|
||||
gettoken := AS_BINNUM;
|
||||
exit;
|
||||
@ -504,25 +504,25 @@ var
|
||||
{ integer number }
|
||||
'0'..'9': begin
|
||||
actasmpattern := c;
|
||||
c := {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c := current_scanner^.asmgetchar;
|
||||
while c in ['0'..'9'] do
|
||||
Begin
|
||||
actasmpattern := actasmpattern + c;
|
||||
c:= {$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:= current_scanner^.asmgetchar;
|
||||
end;
|
||||
gettoken := AS_INTNUM;
|
||||
exit;
|
||||
end;
|
||||
';' : begin
|
||||
repeat
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
until c=newline;
|
||||
firsttoken := TRUE;
|
||||
gettoken:=AS_SEPARATOR;
|
||||
end;
|
||||
|
||||
'{',#13,newline : begin
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
firsttoken := TRUE;
|
||||
gettoken:=AS_SEPARATOR;
|
||||
end;
|
||||
@ -2033,7 +2033,7 @@ var
|
||||
store_p:=p;
|
||||
{ setup label linked list }
|
||||
labellist.init;
|
||||
c:={$ifdef NEWINPUT}current_scanner^.{$endif}asmgetchar;
|
||||
c:=current_scanner^.asmgetchar;
|
||||
actasmtoken:=gettoken;
|
||||
while actasmtoken<>AS_END do
|
||||
Begin
|
||||
@ -2177,7 +2177,10 @@ Begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.3 1998-07-10 10:51:02 peter
|
||||
Revision 1.4 1998-07-14 14:47:02 peter
|
||||
* released NEWINPUT
|
||||
|
||||
Revision 1.3 1998/07/10 10:51:02 peter
|
||||
* m68k updates
|
||||
|
||||
Revision 1.2 1998/06/24 14:06:39 peter
|
||||
|
||||
@ -86,83 +86,11 @@ const
|
||||
preprocpat : string;
|
||||
preproc_token : ttoken;
|
||||
|
||||
{$ifndef NEWINPUT}
|
||||
function 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}
|
||||
|
||||
procedure preproc_consume(t : ttoken);
|
||||
begin
|
||||
if t<>preproc_token then
|
||||
Message(scan_e_preproc_syntax_error);
|
||||
preproc_token:={$ifdef NEWINPUT}current_scanner^.{$endif}readpreproc;
|
||||
preproc_token:=current_scanner^.readpreproc;
|
||||
end;
|
||||
|
||||
function read_expr : string;forward;
|
||||
@ -352,26 +280,18 @@ const
|
||||
begin
|
||||
case t of
|
||||
_DIR_ENDIF : begin
|
||||
{$ifdef NEWINPUT}current_scanner^.{$endif}poppreprocstack;
|
||||
current_scanner^.poppreprocstack;
|
||||
end;
|
||||
_DIR_ELSE : begin
|
||||
{$ifdef NEWINPUT}current_scanner^.{$endif}elsepreprocstack;
|
||||
current_scanner^.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));
|
||||
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
|
||||
@ -382,50 +302,22 @@ const
|
||||
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
|
||||
begin
|
||||
found:=CheckSwitch(hs[1],c);
|
||||
readchar; {read + or -}
|
||||
end
|
||||
else
|
||||
Message(scan_w_illegal_switch);
|
||||
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:=readpreproc;
|
||||
hs:=read_expr;
|
||||
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));
|
||||
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
|
||||
@ -438,19 +330,6 @@ const
|
||||
Message1(scan_d_handling_switch,'$'+directive[t]);
|
||||
end;
|
||||
end;
|
||||
{$else}
|
||||
if (preprocstack=nil) or preprocstack^.accept then
|
||||
break
|
||||
else
|
||||
begin
|
||||
Message(scan_c_skipping_until);
|
||||
repeat
|
||||
skipuntildirective;
|
||||
t:=Get_Directive(readid);
|
||||
until is_conditional(t);
|
||||
end;
|
||||
end;
|
||||
{$endif}
|
||||
end;
|
||||
|
||||
|
||||
@ -463,8 +342,8 @@ const
|
||||
macropos : longint;
|
||||
macrobuffer : pmacrobuffer;
|
||||
begin
|
||||
{$ifdef NEWINPUT}current_scanner^.{$endif}skipspace;
|
||||
hs:={$ifdef NEWINPUT}current_scanner^.{$endif}readid;
|
||||
current_scanner^.skipspace;
|
||||
hs:=current_scanner^.readid;
|
||||
mac:=pmacrosym(macros^.search(hs));
|
||||
if not assigned(mac) then
|
||||
begin
|
||||
@ -493,21 +372,21 @@ const
|
||||
Message(scan_e_keyword_cant_be_a_macro);
|
||||
pattern:=hs2;
|
||||
{ !!!!!! handle macro params, need we this? }
|
||||
{$ifdef NEWINPUT}current_scanner^.{$endif}skipspace;
|
||||
current_scanner^.skipspace;
|
||||
{ may be a macro? }
|
||||
if c=':' then
|
||||
begin
|
||||
{$ifdef NEWINPUT}current_scanner^.{$endif}readchar;
|
||||
current_scanner^.readchar;
|
||||
if c='=' then
|
||||
begin
|
||||
new(macrobuffer);
|
||||
macropos:=0;
|
||||
{ first char }
|
||||
{$ifdef NEWINPUT}current_scanner^.{$endif}readchar;
|
||||
current_scanner^.readchar;
|
||||
while (c<>'}') do
|
||||
begin
|
||||
macrobuffer^[macropos]:=c;
|
||||
{$ifdef NEWINPUT}current_scanner^.{$endif}readchar;
|
||||
current_scanner^.readchar;
|
||||
if c=#26 then Message(scan_f_end_of_file);
|
||||
inc(macropos);
|
||||
if macropos>maxmacrolen then
|
||||
@ -533,8 +412,8 @@ const
|
||||
hs : string;
|
||||
mac : pmacrosym;
|
||||
begin
|
||||
{$ifdef NEWINPUT}current_scanner^.{$endif}skipspace;
|
||||
hs:={$ifdef NEWINPUT}current_scanner^.{$endif}readid;
|
||||
current_scanner^.skipspace;
|
||||
hs:=current_scanner^.readid;
|
||||
mac:=pmacrosym(macros^.search(hs));
|
||||
if not assigned(mac) then
|
||||
begin
|
||||
@ -570,8 +449,8 @@ const
|
||||
_DIR_MESSAGE,
|
||||
_DIR_INFO : w:=scan_i_user_defined;
|
||||
end;
|
||||
{$ifdef NEWINPUT}current_scanner^.{$endif}skipspace;
|
||||
Message1(w,{$ifdef NEWINPUT}current_scanner^.{$endif}readcomment);
|
||||
current_scanner^.skipspace;
|
||||
Message1(w,current_scanner^.readcomment);
|
||||
end;
|
||||
|
||||
|
||||
@ -586,7 +465,7 @@ const
|
||||
{$endif}
|
||||
_DIR_SMARTLINK : sw:=cs_smartlink;
|
||||
end;
|
||||
{$ifdef NEWINPUT}current_scanner^.{$endif}skipspace;
|
||||
current_scanner^.skipspace;
|
||||
if c='-' then
|
||||
aktswitches:=aktswitches-[sw]
|
||||
else
|
||||
@ -603,13 +482,12 @@ const
|
||||
hp : pinputfile;
|
||||
found : boolean;
|
||||
begin
|
||||
{$ifdef NEWINPUT}current_scanner^.{$endif}skipspace;
|
||||
hs:={$ifdef NEWINPUT}current_scanner^.{$endif}readcomment;
|
||||
current_scanner^.skipspace;
|
||||
hs:=current_scanner^.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 }
|
||||
@ -619,32 +497,11 @@ const
|
||||
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));
|
||||
hp^.reset;
|
||||
if ioresult=0 then
|
||||
begin
|
||||
current_module^.current_inputfile^.bufpos:=longint(inputpointer)-longint(inputbuffer);
|
||||
hp^.next:=current_module^.current_inputfile;
|
||||
current_module^.current_inputfile:=hp;
|
||||
status.currentsource:=current_module^.current_inputfile^.name^+current_module^.current_inputfile^.ext^;
|
||||
current_module^.sourcefiles.register_file(hp);
|
||||
current_module^.current_index:=hp^.ref_index;
|
||||
inputbuffer:=current_module^.current_inputfile^.buf;
|
||||
Message1(scan_u_start_include_file,current_module^.current_inputfile^.name^);
|
||||
reload;
|
||||
end
|
||||
else
|
||||
Message1(scan_f_cannot_open_includefile,hs);
|
||||
{$endif NEWINPUT}
|
||||
end;
|
||||
|
||||
|
||||
@ -655,16 +512,16 @@ const
|
||||
|
||||
procedure dir_linkobject(t:tdirectivetoken);
|
||||
begin
|
||||
{$ifdef NEWINPUT}current_scanner^.{$endif}skipspace;
|
||||
{$ifdef NEWINPUT}current_scanner^.{$endif}readstring;
|
||||
current_scanner^.skipspace;
|
||||
current_scanner^.readstring;
|
||||
current_module^.linkofiles.insert(FixFileName(orgpattern));
|
||||
end;
|
||||
|
||||
|
||||
procedure dir_linklib(t:tdirectivetoken);
|
||||
begin
|
||||
{$ifdef NEWINPUT}current_scanner^.{$endif}skipspace;
|
||||
{$ifdef NEWINPUT}current_scanner^.{$endif}readstring;
|
||||
current_scanner^.skipspace;
|
||||
current_scanner^.readstring;
|
||||
current_module^.linkSharedLibs.insert(orgpattern);
|
||||
end;
|
||||
|
||||
@ -675,8 +532,8 @@ const
|
||||
Message(scan_w_switch_is_global)
|
||||
else
|
||||
begin
|
||||
{$ifdef NEWINPUT}current_scanner^.{$endif}skipspace;
|
||||
if set_string_asm({$ifdef NEWINPUT}current_scanner^.{$endif}readid) then
|
||||
current_scanner^.skipspace;
|
||||
if set_string_asm(current_scanner^.readid) then
|
||||
aktoutputformat:=target_asm.id
|
||||
else
|
||||
Message(scan_w_illegal_switch);
|
||||
@ -688,10 +545,10 @@ const
|
||||
var
|
||||
hs : string;
|
||||
begin
|
||||
{$ifdef NEWINPUT}current_scanner^.{$endif}skipspace;
|
||||
current_scanner^.skipspace;
|
||||
if upcase(c)='N' then
|
||||
begin
|
||||
hs:={$ifdef NEWINPUT}current_scanner^.{$endif}readid;
|
||||
hs:=current_scanner^.readid;
|
||||
if hs='NORMAL' then
|
||||
aktpackrecords:=2
|
||||
else
|
||||
@ -699,7 +556,7 @@ const
|
||||
end
|
||||
else
|
||||
begin
|
||||
case {$ifdef NEWINPUT}current_scanner^.{$endif}readval of
|
||||
case current_scanner^.readval of
|
||||
1 : aktpackrecords:=1;
|
||||
2 : aktpackrecords:=2;
|
||||
4 : aktpackrecords:=4;
|
||||
@ -719,8 +576,8 @@ const
|
||||
var
|
||||
s : string;
|
||||
begin
|
||||
{$ifdef NEWINPUT}current_scanner^.{$endif}skipspace;
|
||||
s:={$ifdef NEWINPUT}current_scanner^.{$endif}readid;
|
||||
current_scanner^.skipspace;
|
||||
s:=current_scanner^.readid;
|
||||
if s='DEFAULT' then
|
||||
aktasmmode:=initasmmode
|
||||
else
|
||||
@ -804,9 +661,9 @@ const
|
||||
p : tdirectiveproc;
|
||||
hs : string;
|
||||
begin
|
||||
{$ifdef NEWINPUT}current_scanner^.{$endif}gettokenpos;
|
||||
{$ifdef NEWINPUT}current_scanner^.{$endif}readchar; {Remove the $}
|
||||
hs:={$ifdef NEWINPUT}current_scanner^.{$endif}readid;
|
||||
current_scanner^.gettokenpos;
|
||||
current_scanner^.readchar; {Remove the $}
|
||||
hs:=current_scanner^.readid;
|
||||
Message1(scan_d_handling_switch,'$'+hs);
|
||||
if hs='' then
|
||||
Message1(scan_w_illegal_switch,'$'+hs);
|
||||
@ -814,11 +671,11 @@ const
|
||||
while (length(hs)=1) and (c in ['-','+']) do
|
||||
begin
|
||||
HandleSwitch(hs[1],c);
|
||||
{$ifdef NEWINPUT}current_scanner^.{$endif}readchar; {Remove + or -}
|
||||
current_scanner^.readchar; {Remove + or -}
|
||||
if c=',' then
|
||||
begin
|
||||
{$ifdef NEWINPUT}current_scanner^.{$endif}readchar; {Remove , }
|
||||
hs:={$ifdef NEWINPUT}current_scanner^.{$endif}readid; {Check for multiple switches on one line}
|
||||
current_scanner^.readchar; {Remove , }
|
||||
hs:=current_scanner^.readid; {Check for multiple switches on one line}
|
||||
Message1(scan_d_handling_switch,'$'+hs);
|
||||
end
|
||||
else
|
||||
@ -841,14 +698,17 @@ const
|
||||
else
|
||||
Message1(scan_w_illegal_directive,'$'+hs);
|
||||
{ conditionals already read the comment }
|
||||
if ({$ifdef NEWINPUT}current_scanner^.{$endif}comment_level>0) then
|
||||
{$ifdef NEWINPUT}current_scanner^.{$endif}readcomment;
|
||||
if (current_scanner^.comment_level>0) then
|
||||
current_scanner^.readcomment;
|
||||
end;
|
||||
end;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.13 1998-07-07 12:32:54 peter
|
||||
Revision 1.14 1998-07-14 14:47:03 peter
|
||||
* released NEWINPUT
|
||||
|
||||
Revision 1.13 1998/07/07 12:32:54 peter
|
||||
* status.currentsource is now calculated in verbose (more accurated)
|
||||
|
||||
Revision 1.12 1998/07/07 11:20:10 peter
|
||||
|
||||
@ -34,9 +34,11 @@ unit scanner;
|
||||
{$ifdef TP}
|
||||
maxmacrolen=1024;
|
||||
InputFileBufSize=1024;
|
||||
linebufincrease=64;
|
||||
{$else}
|
||||
maxmacrolen=16*1024;
|
||||
InputFileBufSize=32*1024;
|
||||
linebufincrease=512;
|
||||
{$endif}
|
||||
|
||||
id_len = 14;
|
||||
@ -142,7 +144,6 @@ unit scanner;
|
||||
destructor done;
|
||||
end;
|
||||
|
||||
{$ifdef NEWINPUT}
|
||||
pscannerfile = ^tscannerfile;
|
||||
tscannerfile = object
|
||||
inputfile : pinputfile; { current inputfile list }
|
||||
@ -157,13 +158,15 @@ unit scanner;
|
||||
inputpointer : pchar;
|
||||
|
||||
bufstart,
|
||||
bufidx,
|
||||
bufsize : longint;
|
||||
|
||||
line_no,
|
||||
lasttokenpos,
|
||||
lastlinepos : longint;
|
||||
|
||||
maxlinebuf : longint;
|
||||
linebuf : plongint;
|
||||
|
||||
s_point : boolean;
|
||||
comment_level,
|
||||
yylexcount : longint;
|
||||
@ -176,6 +179,7 @@ unit scanner;
|
||||
function open:boolean;
|
||||
procedure close;
|
||||
function reopen:boolean;
|
||||
procedure seekbuf(fpos:longint);
|
||||
procedure readbuf;
|
||||
procedure saveinputfile;
|
||||
procedure restoreinputfile;
|
||||
@ -187,6 +191,7 @@ unit scanner;
|
||||
procedure gettokenpos;
|
||||
procedure inc_comment_level;
|
||||
procedure dec_comment_level;
|
||||
procedure checkpreprocstack;
|
||||
procedure poppreprocstack;
|
||||
procedure addpreprocstack(a:boolean;const s:string;w:tmsgconst);
|
||||
procedure elsepreprocstack;
|
||||
@ -206,44 +211,12 @@ unit scanner;
|
||||
function readpreproc:ttoken;
|
||||
function asmgetchar:char;
|
||||
end;
|
||||
{$endif NEWINPUT}
|
||||
|
||||
var
|
||||
c : char;
|
||||
orgpattern,
|
||||
pattern : string;
|
||||
{$ifdef NEWINPUT}
|
||||
current_scanner : pscannerfile;
|
||||
{$else}
|
||||
currlinepos,
|
||||
lastlinepos,
|
||||
lasttokenpos,
|
||||
inputbuffer,
|
||||
inputpointer : pchar;
|
||||
s_point : boolean;
|
||||
comment_level,
|
||||
yylexcount,
|
||||
macropos : longint;
|
||||
lastasmgetchar : char;
|
||||
preprocstack : ppreprocstack;
|
||||
{$endif NEWINPUT}
|
||||
|
||||
{$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}
|
||||
|
||||
{ changes to keywords to be tp compatible }
|
||||
procedure change_to_tp_keywords;
|
||||
@ -315,42 +288,6 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
{$ifndef NEWINPUT}
|
||||
|
||||
const
|
||||
current_column : longint = 1;
|
||||
|
||||
function get_current_col : longint;
|
||||
|
||||
begin
|
||||
get_current_col:=current_column;
|
||||
end;
|
||||
|
||||
function get_file_col : longint;
|
||||
begin
|
||||
get_file_col:=lasttokenpos-lastlinepos;
|
||||
end;
|
||||
|
||||
|
||||
procedure inc_comment_level;
|
||||
begin
|
||||
inc(comment_level);
|
||||
if (comment_level>1) then
|
||||
Message1(scan_w_comment_level,tostr(comment_level));
|
||||
end;
|
||||
|
||||
|
||||
procedure dec_comment_level;
|
||||
begin
|
||||
if cs_tp_compatible in aktswitches then
|
||||
comment_level:=0
|
||||
else
|
||||
dec(comment_level);
|
||||
end;
|
||||
|
||||
{$endif NEWINPUT}
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
TPreProcStack
|
||||
*****************************************************************************}
|
||||
@ -367,9 +304,6 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
|
||||
{$ifdef NEWINPUT}
|
||||
|
||||
{****************************************************************************
|
||||
TSCANNERFILE
|
||||
****************************************************************************}
|
||||
@ -396,6 +330,8 @@ implementation
|
||||
line_no:=0;
|
||||
lastlinepos:=0;
|
||||
lasttokenpos:=0;
|
||||
linebuf:=nil;
|
||||
maxlinebuf:=0;
|
||||
{ load block }
|
||||
if not open then
|
||||
Message(scan_f_cannot_open_input);
|
||||
@ -405,18 +341,23 @@ implementation
|
||||
|
||||
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;
|
||||
checkpreprocstack;
|
||||
{ close file }
|
||||
if not closed then
|
||||
close;
|
||||
end;
|
||||
|
||||
|
||||
procedure tscannerfile.seekbuf(fpos:longint);
|
||||
begin
|
||||
if closed then
|
||||
exit;
|
||||
seek(f,fpos);
|
||||
bufstart:=fpos;
|
||||
bufsize:=0;
|
||||
end;
|
||||
|
||||
|
||||
procedure tscannerfile.readbuf;
|
||||
{$ifdef TP}
|
||||
var
|
||||
@ -523,6 +464,8 @@ implementation
|
||||
inputfile^.saveline_no:=line_no;
|
||||
inputfile^.saveinputbuffer:=inputbuffer;
|
||||
inputfile^.saveinputpointer:=inputpointer;
|
||||
inputfile^.linebuf:=linebuf;
|
||||
inputfile^.maxlinebuf:=maxlinebuf;
|
||||
end;
|
||||
|
||||
|
||||
@ -534,6 +477,8 @@ implementation
|
||||
line_no:=inputfile^.saveline_no;
|
||||
inputbuffer:=inputfile^.saveinputbuffer;
|
||||
inputpointer:=inputfile^.saveinputpointer;
|
||||
linebuf:=inputfile^.linebuf;
|
||||
maxlinebuf:=inputfile^.maxlinebuf;
|
||||
end;
|
||||
|
||||
|
||||
@ -574,7 +519,6 @@ implementation
|
||||
if filenotatend then
|
||||
begin
|
||||
readbuf;
|
||||
{ fixbuf; }
|
||||
if line_no=0 then
|
||||
line_no:=1;
|
||||
inputpointer:=inputbuffer;
|
||||
@ -642,6 +586,9 @@ implementation
|
||||
procedure tscannerfile.linebreak;
|
||||
var
|
||||
cur : char;
|
||||
{$ifdef SourceLine}
|
||||
hp : plongint;
|
||||
{$endif SourceLine}
|
||||
begin
|
||||
if (byte(inputpointer^)=0) and
|
||||
filenotatend then
|
||||
@ -661,118 +608,41 @@ implementation
|
||||
{ increase line counters }
|
||||
lastlinepos:=bufstart+(inputpointer-inputbuffer);
|
||||
inc(line_no);
|
||||
{ update linebuffer }
|
||||
{$ifdef SourceLine}
|
||||
if line_no>maxlinebuf then
|
||||
begin
|
||||
{ create new linebuf and move old info }
|
||||
getmem(hp,maxlinebuf+linebufincrease);
|
||||
if assigned(linebuf) then
|
||||
begin
|
||||
move(linebuf^,hp^,maxlinebuf shl 2);
|
||||
freemem(linebuf,maxlinebuf);
|
||||
end;
|
||||
{ set new linebuf }
|
||||
linebuf:=hp;
|
||||
inc(maxlinebuf,linebufincrease);
|
||||
end;
|
||||
plongint(longint(linebuf)+line_no*2)^:=lastlinepos;
|
||||
{$endif SourceLine}
|
||||
{ update for status }
|
||||
inc(status.compiledlines);
|
||||
Comment(V_Status,'');
|
||||
end;
|
||||
|
||||
{$else NEWINPUT}
|
||||
|
||||
procedure gettokenpos;
|
||||
{ load the values of tokenpos and lasttokenpos }
|
||||
procedure tscannerfile.checkpreprocstack;
|
||||
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;
|
||||
i,saveline : longint;
|
||||
begin
|
||||
if not assigned(current_module^.current_inputfile) then
|
||||
internalerror(14);
|
||||
if current_module^.current_inputfile^.filenotatend then
|
||||
{ check for missing ifdefs }
|
||||
while assigned(preprocstack) do
|
||||
begin
|
||||
{ load the next piece of source }
|
||||
blockread(current_module^.current_inputfile^.f,inputbuffer^,
|
||||
current_module^.current_inputfile^.bufsize-1,readsize);
|
||||
{ Scan the buffer for #0 chars, which are not alllowed }
|
||||
if readsize > 0 then
|
||||
begin
|
||||
{ force proper line counting }
|
||||
saveline:=current_module^.current_inputfile^.true_line;
|
||||
i:=0;
|
||||
inputpointer:=inputbuffer;
|
||||
while i<readsize do
|
||||
begin
|
||||
c:=inputpointer^;
|
||||
case c of
|
||||
#0 : Message(scan_f_illegal_char);
|
||||
#10,#13 : begin
|
||||
if (byte(c)+byte(inputpointer[1])=23) then
|
||||
begin
|
||||
inc(longint(inputpointer));
|
||||
inc(i);
|
||||
end;
|
||||
inc(current_module^.current_inputfile^.true_line);
|
||||
end;
|
||||
end;
|
||||
inc(i);
|
||||
inc(longint(inputpointer));
|
||||
end;
|
||||
current_module^.current_inputfile^.true_line:=saveline;
|
||||
end;
|
||||
inputbuffer[readsize]:=#0;
|
||||
inputpointer:=inputbuffer;
|
||||
currlinepos:=inputpointer;
|
||||
{ Set EOF when main source and at endoffile }
|
||||
if eof(current_module^.current_inputfile^.f) then
|
||||
begin
|
||||
current_module^.current_inputfile^.filenotatend:=false;
|
||||
if current_module^.current_inputfile^.next=nil then
|
||||
inputbuffer[readsize]:=#26;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
current_module^.current_inputfile^.close;
|
||||
{ load next module }
|
||||
current_module^.current_inputfile:=current_module^.current_inputfile^.next;
|
||||
current_module^.current_index:=current_module^.current_inputfile^.ref_index;
|
||||
status.currentsource:=current_module^.current_inputfile^.name^+current_module^.current_inputfile^.ext^;
|
||||
inputbuffer:=current_module^.current_inputfile^.buf;
|
||||
inputpointer:=inputbuffer+current_module^.current_inputfile^.bufpos;
|
||||
currlinepos:=inputpointer;
|
||||
Message3(scan_e_endif_expected,'$IF(N)(DEF)',preprocstack^.name,tostr(preprocstack^.line_nb));
|
||||
poppreprocstack;
|
||||
end;
|
||||
lastlinepos:=currlinepos;
|
||||
{ load next char }
|
||||
c:=inputpointer^;
|
||||
inc(longint(inputpointer));
|
||||
end;
|
||||
|
||||
procedure linebreak;
|
||||
var
|
||||
cur : char;
|
||||
begin
|
||||
if (byte(inputpointer^)=0) and
|
||||
current_module^.current_inputfile^.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;
|
||||
{ status }
|
||||
Comment(V_Status,'');
|
||||
{ increase line counters }
|
||||
inc(current_module^.current_inputfile^.true_line);
|
||||
currlinepos:=inputpointer;
|
||||
inc(status.compiledlines);
|
||||
end;
|
||||
|
||||
{$endif NEWINPUT}
|
||||
|
||||
|
||||
procedure {$ifdef NEWINPUT}tscannerfile.{$endif}poppreprocstack;
|
||||
procedure tscannerfile.poppreprocstack;
|
||||
var
|
||||
hp : ppreprocstack;
|
||||
begin
|
||||
@ -787,11 +657,11 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure {$ifdef NEWINPUT}tscannerfile.{$endif}addpreprocstack(a:boolean;const s:string;w:tmsgconst);
|
||||
procedure tscannerfile.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;
|
||||
preprocstack^.line_nb:=line_no;
|
||||
if preprocstack^.accept then
|
||||
Message2(w,preprocstack^.name,'accepted')
|
||||
else
|
||||
@ -799,7 +669,7 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure {$ifdef NEWINPUT}tscannerfile.{$endif}elsepreprocstack;
|
||||
procedure tscannerfile.elsepreprocstack;
|
||||
begin
|
||||
if assigned(preprocstack) then
|
||||
begin
|
||||
@ -815,7 +685,7 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure {$ifdef NEWINPUT}tscannerfile.{$endif}readchar;
|
||||
procedure tscannerfile.readchar;
|
||||
begin
|
||||
c:=inputpointer^;
|
||||
if c=#0 then
|
||||
@ -827,7 +697,7 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure {$ifdef NEWINPUT}tscannerfile.{$endif}readstring;
|
||||
procedure tscannerfile.readstring;
|
||||
var
|
||||
i : longint;
|
||||
begin
|
||||
@ -873,7 +743,7 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure {$ifdef NEWINPUT}tscannerfile.{$endif}readnumber;
|
||||
procedure tscannerfile.readnumber;
|
||||
var
|
||||
base,
|
||||
i : longint;
|
||||
@ -920,14 +790,14 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function {$ifdef NEWINPUT}tscannerfile.{$endif}readid:string;
|
||||
function tscannerfile.readid:string;
|
||||
begin
|
||||
readstring;
|
||||
readid:=pattern;
|
||||
end;
|
||||
|
||||
|
||||
function {$ifdef NEWINPUT}tscannerfile.{$endif}readval:longint;
|
||||
function tscannerfile.readval:longint;
|
||||
var
|
||||
l : longint;
|
||||
w : word;
|
||||
@ -938,7 +808,7 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function {$ifdef NEWINPUT}tscannerfile.{$endif}readcomment:string;
|
||||
function tscannerfile.readcomment:string;
|
||||
var
|
||||
i : longint;
|
||||
begin
|
||||
@ -972,7 +842,7 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure {$ifdef NEWINPUT}tscannerfile.{$endif}skipspace;
|
||||
procedure tscannerfile.skipspace;
|
||||
begin
|
||||
while c in [' ',#9..#13] do
|
||||
begin
|
||||
@ -987,7 +857,7 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure {$ifdef NEWINPUT}tscannerfile.{$endif}skipuntildirective;
|
||||
procedure tscannerfile.skipuntildirective;
|
||||
var
|
||||
found : longint;
|
||||
begin
|
||||
@ -1023,7 +893,7 @@ implementation
|
||||
|
||||
{$i scandir.inc}
|
||||
|
||||
procedure {$ifdef NEWINPUT}tscannerfile.{$endif}skipcomment;
|
||||
procedure tscannerfile.skipcomment;
|
||||
begin
|
||||
readchar;
|
||||
inc_comment_level;
|
||||
@ -1049,7 +919,7 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure {$ifdef NEWINPUT}tscannerfile.{$endif}skipdelphicomment;
|
||||
procedure tscannerfile.skipdelphicomment;
|
||||
begin
|
||||
inc_comment_level;
|
||||
readchar;
|
||||
@ -1067,7 +937,7 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure {$ifdef NEWINPUT}tscannerfile.{$endif}skipoldtpcomment;
|
||||
procedure tscannerfile.skipoldtpcomment;
|
||||
var
|
||||
found : longint;
|
||||
begin
|
||||
@ -1113,7 +983,7 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
function {$ifdef NEWINPUT}tscannerfile.{$endif}yylex : ttoken;
|
||||
function tscannerfile.yylex : ttoken;
|
||||
var
|
||||
y : ttoken;
|
||||
code : word;
|
||||
@ -1154,10 +1024,6 @@ implementation
|
||||
|
||||
{ Save current token position }
|
||||
gettokenpos;
|
||||
{$ifndef NEWINPUT}
|
||||
lastlinepos:=currlinepos;
|
||||
lasttokenpos:=inputpointer;
|
||||
{$endif}
|
||||
|
||||
{ Check first for a identifier/keyword, this is 20+% faster (PFV) }
|
||||
if c in ['_','A'..'Z','a'..'z'] then
|
||||
@ -1175,28 +1041,10 @@ implementation
|
||||
begin
|
||||
{ don't forget the last char }
|
||||
dec(longint(inputpointer));
|
||||
{$ifdef NEWINPUT}
|
||||
hp:=new(pinputfile,init('Macro '+pattern));
|
||||
addfile(hp);
|
||||
getmem(macbuf,mac^.buflen+1);
|
||||
setbuf(macbuf,mac^.buflen+1);
|
||||
{$else}
|
||||
current_module^.current_inputfile^.bufpos:=inputpointer-inputbuffer;
|
||||
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^;
|
||||
{ I don't think that we should do that
|
||||
because otherwise the file will be searched !! (PM)
|
||||
but there is the problem of index !! }
|
||||
current_module^.sourcefiles.register_file(hp);
|
||||
current_module^.current_index:=hp^.ref_index;
|
||||
{ set an own buffer }
|
||||
getmem(macbuf,mac^.buflen+1);
|
||||
current_module^.current_inputfile^.setbuf(macbuf,mac^.buflen+1);
|
||||
inputbuffer:=current_module^.current_inputfile^.buf;
|
||||
{$endif NEWINPUT}
|
||||
{ copy text }
|
||||
move(mac^.buftext^,inputbuffer^,mac^.buflen);
|
||||
{ put end sign }
|
||||
@ -1551,19 +1399,9 @@ implementation
|
||||
end;
|
||||
end;
|
||||
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;
|
||||
{$endif NEWINPUT}
|
||||
end;
|
||||
|
||||
|
||||
{$ifdef NEWINPUT}
|
||||
function tscannerfile.readpreproc:ttoken;
|
||||
begin
|
||||
skipspace;
|
||||
@ -1633,10 +1471,9 @@ exit_label:
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
|
||||
function {$ifdef NEWINPUT}tscannerfile.{$endif}asmgetchar : char;
|
||||
function tscannerfile.asmgetchar : char;
|
||||
begin
|
||||
if lastasmgetchar<>#0 then
|
||||
begin
|
||||
@ -1683,82 +1520,13 @@ exit_label:
|
||||
end;
|
||||
end;
|
||||
|
||||
{$ifdef NEWINPUT}
|
||||
|
||||
{$else NEWPPU}
|
||||
|
||||
procedure InitScanner(const fn: string);
|
||||
var
|
||||
d:dirstr;
|
||||
n:namestr;
|
||||
e:extstr;
|
||||
begin
|
||||
fsplit(fn,d,n,e);
|
||||
current_module^.current_inputfile:=new(pinputfile,init(d,n,e));
|
||||
if not current_module^.current_inputfile^.reset then
|
||||
Message(scan_f_cannot_open_input);
|
||||
current_module^.sourcefiles.register_file(current_module^.current_inputfile);
|
||||
current_module^.current_index:=current_module^.current_inputfile^.ref_index;
|
||||
status.currentsource:=current_module^.current_inputfile^.name^+current_module^.current_inputfile^.ext^;
|
||||
inputbuffer:=current_module^.current_inputfile^.buf;
|
||||
reload;
|
||||
preprocstack:=nil;
|
||||
comment_level:=0;
|
||||
lasttokenpos:=inputpointer;
|
||||
lastlinepos:=inputpointer;
|
||||
currlinepos:=inputpointer;
|
||||
s_point:=false;
|
||||
block_type:=bt_general;
|
||||
end;
|
||||
|
||||
procedure get_cur_file_pos(var fileinfo : tfileposinfo);
|
||||
begin
|
||||
with fileinfo do
|
||||
begin
|
||||
line:=current_module^.current_inputfile^.line_no;
|
||||
fileindex:=current_module^.current_index;
|
||||
column:=get_current_col;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure set_cur_file_pos(const fileinfo : tfileposinfo);
|
||||
begin
|
||||
if current_module^.current_index<>fileinfo.fileindex then
|
||||
begin
|
||||
current_module^.current_index:=fileinfo.fileindex;
|
||||
current_module^.current_inputfile:=
|
||||
pinputfile(current_module^.sourcefiles.get_file(fileinfo.fileindex));
|
||||
end;
|
||||
if assigned(current_module^.current_inputfile) then
|
||||
begin
|
||||
current_module^.current_inputfile^.line_no:=fileinfo.line;
|
||||
current_module^.current_inputfile^.column:=fileinfo.column;
|
||||
current_column:=fileinfo.column;
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure DoneScanner(testendif:boolean);
|
||||
begin
|
||||
if (not testendif) then
|
||||
begin
|
||||
while assigned(preprocstack) do
|
||||
begin
|
||||
Message3(scan_e_endif_expected,'$IF(N)(DEF)',preprocstack^.name,tostr(preprocstack^.line_nb));
|
||||
poppreprocstack;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{$endif NEWINPUT}
|
||||
|
||||
|
||||
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.33 1998-07-10 10:48:40 peter
|
||||
Revision 1.34 1998-07-14 14:47:04 peter
|
||||
* released NEWINPUT
|
||||
|
||||
Revision 1.33 1998/07/10 10:48:40 peter
|
||||
* fixed realnumber scanning
|
||||
* [] after asmblock was not uppercased anymore
|
||||
|
||||
|
||||
@ -204,15 +204,7 @@
|
||||
if assigned(sym) then
|
||||
begin
|
||||
name := sym^.name;
|
||||
{$ifdef NEWINPUT}
|
||||
|
||||
|
||||
sym_line_no:=sym^.fileinfo.line;
|
||||
{$else}
|
||||
sym_line_no:=sym^.line_no;
|
||||
{$endif}
|
||||
|
||||
|
||||
end
|
||||
else
|
||||
begin
|
||||
@ -1065,15 +1057,7 @@
|
||||
if assigned(sym) then
|
||||
begin
|
||||
st := sym^.name;
|
||||
{$ifdef NEWINPUT}
|
||||
|
||||
|
||||
sym_line_no:=sym^.fileinfo.line;
|
||||
{$else}
|
||||
sym_line_no:=sym^.line_no;
|
||||
{$endif}
|
||||
|
||||
|
||||
end
|
||||
else
|
||||
begin
|
||||
@ -2674,7 +2658,10 @@
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.18 1998-07-10 10:51:04 peter
|
||||
Revision 1.19 1998-07-14 14:47:05 peter
|
||||
* released NEWINPUT
|
||||
|
||||
Revision 1.18 1998/07/10 10:51:04 peter
|
||||
* m68k updates
|
||||
|
||||
Revision 1.16 1998/07/07 11:20:13 peter
|
||||
|
||||
@ -132,8 +132,6 @@
|
||||
end;
|
||||
|
||||
|
||||
{$ifdef NEWINPUT}
|
||||
|
||||
procedure writesourcefiles;
|
||||
var
|
||||
hp : pinputfile;
|
||||
@ -154,29 +152,6 @@
|
||||
current_ppu^.writeentry(ibsourcefiles);
|
||||
end;
|
||||
|
||||
{$else}
|
||||
|
||||
procedure writesourcefiles;
|
||||
var
|
||||
hp2 : pextfile;
|
||||
index : longint;
|
||||
begin
|
||||
{ second write the used source files }
|
||||
hp2:=current_module^.sourcefiles.files;
|
||||
index:=current_module^.sourcefiles.last_ref_index;
|
||||
while assigned(hp2) do
|
||||
begin
|
||||
{ only name and extension }
|
||||
current_ppu^.putstring(hp2^.name^+hp2^.ext^);
|
||||
{ index in that order }
|
||||
hp2^.ref_index:=index;
|
||||
dec(index);
|
||||
hp2:=hp2^._next;
|
||||
end;
|
||||
current_ppu^.writeentry(ibsourcefiles);
|
||||
end;
|
||||
|
||||
{$endif NEWINPUT}
|
||||
|
||||
procedure writeusedunit;
|
||||
var
|
||||
@ -722,7 +697,10 @@
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.6 1998-07-07 11:20:14 peter
|
||||
Revision 1.7 1998-07-14 14:47:07 peter
|
||||
* released NEWINPUT
|
||||
|
||||
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
|
||||
|
||||
@ -34,14 +34,7 @@
|
||||
{$ifdef GDB}
|
||||
isstabwritten := false;
|
||||
{$endif GDB}
|
||||
{$ifdef NEWINPUT}
|
||||
fileinfo:=aktfilepos;
|
||||
{$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;
|
||||
@ -62,14 +55,7 @@
|
||||
right:=nil;
|
||||
setname(readstring);
|
||||
typ:=abstractsym;
|
||||
{$ifdef NEWINPUT}
|
||||
|
||||
fillchar(fileinfo,sizeof(fileinfo),0);
|
||||
{$else}
|
||||
|
||||
line_no:=0;
|
||||
{$endif}
|
||||
|
||||
if object_options then
|
||||
properties:=symprop(readbyte)
|
||||
else
|
||||
@ -337,13 +323,8 @@
|
||||
function tsym.stabstring : pchar;
|
||||
|
||||
begin
|
||||
stabstring:=strpnew('"'+name+'",'+tostr(N_LSYM)+',0,'+tostr(
|
||||
{$ifdef NEWINPUT}
|
||||
fileinfo.line
|
||||
{$else}
|
||||
line_no
|
||||
{$endif}
|
||||
)+',0');
|
||||
stabstring:=strpnew('"'+name+'",'+tostr(N_LSYM)+',0,'+
|
||||
tostr(fileinfo.line)+',0');
|
||||
end;
|
||||
|
||||
procedure tsym.concatstabto(asmlist : paasmoutput);
|
||||
@ -557,11 +538,7 @@
|
||||
stabstring :=strpnew('"'+obj+':'+RetType
|
||||
+definition^.retdef^.numberstring+info+'",'+tostr(n_function)
|
||||
+',0,'+
|
||||
{$ifdef NEWINPUT}
|
||||
tostr(aktfilepos.line)
|
||||
{$else}
|
||||
tostr(current_module^.current_inputfile^.line_no)
|
||||
{$endif}
|
||||
+','+definition^.mangledname);
|
||||
end;
|
||||
|
||||
@ -1097,7 +1074,7 @@
|
||||
if use_gsym then st := 'G' else st := 'S';
|
||||
stabstring := strpnew('"'+owner^.name^+'__'+name+':'+
|
||||
+definition^.numberstring+'",'+
|
||||
tostr(N_LCSYM)+',0,'+tostr({$ifdef NEWINPUT}fileinfo.line{$else}line_no{$endif})+','+mangledname);
|
||||
tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
|
||||
end
|
||||
else if (owner^.symtabletype = globalsymtable) or
|
||||
(owner^.symtabletype = unitsymtable) then
|
||||
@ -1109,13 +1086,13 @@
|
||||
if use_gsym then st := 'G' else st := 'S';
|
||||
stabstring := strpnew('"'+name+':'+st
|
||||
+definition^.numberstring+'",'+
|
||||
tostr(N_LCSYM)+',0,'+tostr({$ifdef NEWINPUT}fileinfo.line{$else}line_no{$endif})+','+mangledname);
|
||||
tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
|
||||
end
|
||||
else if owner^.symtabletype = staticsymtable then
|
||||
begin
|
||||
stabstring := strpnew('"'+name+':S'
|
||||
+definition^.numberstring+'",'+
|
||||
tostr(N_LCSYM)+',0,'+tostr({$ifdef NEWINPUT}fileinfo.line{$else}line_no{$endif})+','+mangledname);
|
||||
tostr(N_LCSYM)+',0,'+tostr(fileinfo.line)+','+mangledname);
|
||||
end
|
||||
else if (owner^.symtabletype=parasymtable) then
|
||||
begin
|
||||
@ -1129,8 +1106,8 @@
|
||||
end;
|
||||
stabstring := strpnew('"'+name+':'+st
|
||||
+definition^.numberstring+'",'+
|
||||
tostr(N_PSYM)+',0,'+tostr({$ifdef NEWINPUT}fileinfo.line{$else}line_no{$endif})+','+
|
||||
tostr(address+owner^.call_offset))
|
||||
tostr(N_PSYM)+',0,'+tostr(fileinfo.line)+','+
|
||||
tostr(address+owner^.call_offset));
|
||||
{offset to ebp => will not work if the framepointer is esp
|
||||
so some optimizing will make things harder to debug }
|
||||
end
|
||||
@ -1142,15 +1119,14 @@
|
||||
{ this is the register order for GDB}
|
||||
stabstring:=strpnew('"'+name+':r'
|
||||
+definition^.numberstring+'",'+
|
||||
tostr(N_RSYM)+',0,'+tostr(
|
||||
{$ifdef NEWINPUT}fileinfo.line{$else}line_no{$endif})+','+tostr(GDB_i386index[reg]));
|
||||
tostr(N_RSYM)+',0,'+
|
||||
tostr(fileinfo.line)+','+tostr(GDB_i386index[reg]));
|
||||
end
|
||||
else
|
||||
{$endif i386}
|
||||
stabstring := strpnew('"'+name+':'
|
||||
+definition^.numberstring+'",'+
|
||||
tostr(N_LSYM)+',0,'+tostr(
|
||||
{$ifdef NEWINPUT}fileinfo.line{$else}line_no{$endif})+',-'+tostr(address))
|
||||
tostr(N_LSYM)+',0,'+tostr(fileinfo.line)+',-'+tostr(address))
|
||||
else
|
||||
stabstring := inherited stabstring;
|
||||
end;
|
||||
@ -1169,8 +1145,8 @@
|
||||
{ this is the register order for GDB}
|
||||
stab_str:=strpnew('"'+name+':r'
|
||||
+definition^.numberstring+'",'+
|
||||
tostr(N_RSYM)+',0,'+tostr(
|
||||
{$ifdef NEWINPUT}fileinfo.line{$else}line_no{$endif})+','+tostr(GDB_i386index[reg]));
|
||||
tostr(N_RSYM)+',0,'+
|
||||
tostr(fileinfo.line)+','+tostr(GDB_i386index[reg]));
|
||||
asmlist^.concat(new(pai_stabs,init(stab_str)));
|
||||
end;
|
||||
{$endif i386}
|
||||
@ -1287,9 +1263,9 @@
|
||||
st := 'G'
|
||||
else
|
||||
st := 'S';
|
||||
stabstring := strpnew('"'+name+':'+st
|
||||
+definition^.numberstring+'",'+tostr(n_STSYM)+',0,'+tostr(
|
||||
{$ifdef NEWINPUT}fileinfo.line{$else}line_no{$endif})+','+mangledname);
|
||||
stabstring := strpnew('"'+name+':'+st+
|
||||
definition^.numberstring+'",'+tostr(n_STSYM)+',0,'+
|
||||
tostr(fileinfo.line)+','+mangledname);
|
||||
end;
|
||||
{$endif GDB}
|
||||
|
||||
@ -1413,8 +1389,8 @@
|
||||
{ sets are not recognized by GDB}
|
||||
{***}
|
||||
end;
|
||||
stabstring := strpnew('"'+name+':c='+st+'",'+tostr(N_function)+',0,'+tostr(
|
||||
{$ifdef NEWINPUT}fileinfo.line{$else}line_no{$endif})+',0');
|
||||
stabstring := strpnew('"'+name+':c='+st+'",'+tostr(N_function)+',0,'+
|
||||
tostr(fileinfo.line)+',0');
|
||||
end;
|
||||
|
||||
procedure tconstsym.concatstabto(asmlist : paasmoutput);
|
||||
@ -1586,7 +1562,7 @@
|
||||
else
|
||||
stabchar := 't';
|
||||
short := '"'+name+':'+stabchar+definition^.numberstring
|
||||
+'",'+tostr(N_LSYM)+',0,'+tostr({$ifdef NEWINPUT}fileinfo.line{$else}line_no{$endif})+',0';
|
||||
+'",'+tostr(N_LSYM)+',0,'+tostr(fileinfo.line)+',0';
|
||||
stabstring := strpnew(short);
|
||||
end;
|
||||
|
||||
@ -1644,7 +1620,10 @@
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.21 1998-07-13 21:17:38 florian
|
||||
Revision 1.22 1998-07-14 14:47:08 peter
|
||||
* released NEWINPUT
|
||||
|
||||
Revision 1.21 1998/07/13 21:17:38 florian
|
||||
* changed to compile with TP
|
||||
|
||||
Revision 1.20 1998/07/10 00:00:05 peter
|
||||
|
||||
@ -283,9 +283,6 @@ 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);
|
||||
@ -576,17 +573,6 @@ unit tree;
|
||||
_to^.fileinfo:=from^.fileinfo;
|
||||
end;
|
||||
|
||||
{$ifndef NEWINPUT}
|
||||
procedure set_current_file_line(_to : ptree);
|
||||
|
||||
begin
|
||||
current_module^.current_inputfile:=
|
||||
pinputfile(current_module^.sourcefiles.get_file(_to^.fileinfo.fileindex));
|
||||
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
|
||||
p^.fileinfo:=filepos;
|
||||
@ -1609,7 +1595,10 @@ unit tree;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.19 1998-07-08 14:56:53 daniel
|
||||
Revision 1.20 1998-07-14 14:47:11 peter
|
||||
* released NEWINPUT
|
||||
|
||||
Revision 1.19 1998/07/08 14:56:53 daniel
|
||||
* Fixed $ifdef TP.
|
||||
|
||||
Revision 1.18 1998/07/07 11:20:18 peter
|
||||
|
||||
@ -32,9 +32,6 @@ function _internalerror(i : longint) : boolean;
|
||||
implementation
|
||||
uses
|
||||
verbose,globals,
|
||||
{$ifndef NEWINPUT}
|
||||
files,
|
||||
{$endif}
|
||||
strings,dos;
|
||||
|
||||
const
|
||||
@ -140,22 +137,17 @@ begin
|
||||
if (verbosity and Level)=V_Fatal then
|
||||
hs:=rh_errorstr;
|
||||
end;
|
||||
{$ifdef NEWINPUT}
|
||||
if (Level<$100) and (status.currentline>0) then
|
||||
if (Level<=V_ShowFile) 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}
|
||||
if UseStdErr and (Level<$100) then
|
||||
if UseStdErr then
|
||||
begin
|
||||
writeln(stderr,hs);
|
||||
flush(stderr);
|
||||
@ -193,7 +185,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.12 1998-07-07 11:20:19 peter
|
||||
Revision 1.13 1998-07-14 14:47:12 peter
|
||||
* released NEWINPUT
|
||||
|
||||
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
|
||||
|
||||
@ -33,22 +33,23 @@ uses messages;
|
||||
|
||||
Const
|
||||
MaxErrorCount : longint = 50;
|
||||
{ <$100 can include file and linenr info }
|
||||
{ <$10000 will show file and line }
|
||||
V_Fatal = $0;
|
||||
V_Error = $1;
|
||||
V_Normal = $2;
|
||||
V_Normal = $2; { doesn't show a text like Error: }
|
||||
V_Warning = $4;
|
||||
V_Note = $8;
|
||||
V_Hint = $10;
|
||||
V_Info = $100;
|
||||
V_Status = $200;
|
||||
V_Used = $400;
|
||||
V_Tried = $800;
|
||||
V_Macro = $1000;
|
||||
V_Procedure = $2000;
|
||||
V_Conditional = $4000;
|
||||
V_Debug = $8000;
|
||||
V_Macro = $100;
|
||||
V_Procedure = $200;
|
||||
V_Conditional = $400;
|
||||
V_Info = $10000;
|
||||
V_Status = $20000;
|
||||
V_Used = $40000;
|
||||
V_Tried = $80000;
|
||||
V_Debug = $100000;
|
||||
|
||||
V_ShowFile = $ffff;
|
||||
V_All = $ffffffff;
|
||||
V_Default = V_Fatal + V_Error + V_Normal;
|
||||
|
||||
@ -97,10 +98,7 @@ var
|
||||
|
||||
implementation
|
||||
uses
|
||||
{$ifdef NEWINPUT}
|
||||
files,
|
||||
{$endif}
|
||||
|
||||
globals;
|
||||
|
||||
procedure LoadMsgFile(const fn:string);
|
||||
@ -233,11 +231,9 @@ begin
|
||||
if (l and V_Error)<>0 then
|
||||
inc(status.errorcount);
|
||||
{ fix status }
|
||||
{$ifdef NEWINPUT}
|
||||
status.currentline:=aktfilepos.line;
|
||||
status.currentcolumn:=aktfilepos.column;
|
||||
if assigned(current_module) and
|
||||
|
||||
((current_module^.unit_index<>lastmoduleidx) or
|
||||
(current_module^.current_index<>lastfileidx)) then
|
||||
begin
|
||||
@ -245,8 +241,6 @@ begin
|
||||
lastmoduleidx:=current_module^.unit_index;
|
||||
lastfileidx:=current_module^.current_index;
|
||||
end;
|
||||
|
||||
{$endif}
|
||||
{ show comment }
|
||||
if do_comment(l,s) or dostop or (status.errorcount>=maxerrorcount) then
|
||||
stop
|
||||
@ -300,11 +294,9 @@ begin
|
||||
Replace(s,'$VER',version_string);
|
||||
Replace(s,'$TARGET',target_string);
|
||||
{ fix status }
|
||||
{$ifdef NEWINPUT}
|
||||
status.currentline:=aktfilepos.line;
|
||||
status.currentcolumn:=aktfilepos.column;
|
||||
if assigned(current_module) and
|
||||
|
||||
((current_module^.unit_index<>lastmoduleidx) or
|
||||
(current_module^.current_index<>lastfileidx)) then
|
||||
begin
|
||||
@ -312,8 +304,6 @@ begin
|
||||
lastmoduleidx:=current_module^.unit_index;
|
||||
lastfileidx:=current_module^.current_index;
|
||||
end;
|
||||
|
||||
{$endif}
|
||||
{ show comment }
|
||||
if do_comment(v,s) or dostop or (status.errorcount>=maxerrorcount) then
|
||||
stop;
|
||||
@ -352,7 +342,10 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.10 1998-07-07 12:32:56 peter
|
||||
Revision 1.11 1998-07-14 14:47:13 peter
|
||||
* released NEWINPUT
|
||||
|
||||
Revision 1.10 1998/07/07 12:32:56 peter
|
||||
* status.currentsource is now calculated in verbose (more accurated)
|
||||
|
||||
Revision 1.9 1998/07/07 11:20:20 peter
|
||||
|
||||
Loading…
Reference in New Issue
Block a user