paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-17 19:11:03 +02:00
Code Issues Packages Projects Releases Wiki Activity

* recordtype.field support in constant expressions

Browse Source 
* fixed imul for oa_imm8 which was not allowed
  * fixed reading of local typed constants
  * fixed comment reading which is not any longer a separator
This commit is contained in:
peter 1998-11-05 23:48:17 +00:00
parent dedaf4db95
commit d84489d9b7
7 changed files with 435 additions and 431 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

331
compiler/asmutils.pas
View File

@ -268,10 +268,9 @@ Type
{ Symbol helper routines } { Symbol helper routines }
{---------------------------------------------------------------------} {---------------------------------------------------------------------}
Function GetTypeOffset(var Instr: TInstruction; const base: string; const field: string; Procedure SetOperandSize(var instr:TInstruction;operandnum,size:longint);
Var Offset: longint; operandnum: byte):boolean; Function GetVarOffsetSize(const base,field:string;Var Offset: longint;var Size:longint):boolean;
Function GetVarOffset(var Instr: TInstruction;const base: string; const field: string; Function GetTypeOffsetSize(const base,field: string;Var Offset: longint;var Size:longint):boolean;
Var Offset: longint; operandnum: byte):boolean;
Function SearchIConstant(const s:string; var l:longint): boolean; Function SearchIConstant(const s:string; var l:longint): boolean;
Function SearchLabel(const s: string; var hl: plabel): boolean; Function SearchLabel(const s: string; var hl: plabel): boolean;
Function CreateVarInstr(var Instr: TInstruction; const hs:string; Function CreateVarInstr(var Instr: TInstruction; const hs:string;
@ -1000,8 +999,10 @@ end;
getsym(s,false); getsym(s,false);
if srsym <> nil then if srsym <> nil then
Begin Begin
if (srsym^.typ=constsym) and case srsym^.typ of
(pconstsym(srsym)^.consttype in [constord,constint,constchar,constbool]) then constsym :
begin
if (pconstsym(srsym)^.consttype in [constord,constint,constchar,constbool]) then
Begin Begin
l:=pconstsym(srsym)^.value; l:=pconstsym(srsym)^.value;
SearchIConstant := TRUE; SearchIConstant := TRUE;
@ -1009,6 +1010,8 @@ end;
end; end;
end; end;
end; end;
end;
end;
Procedure SetupResult(Var Instr:TInstruction; operandnum: byte); Procedure SetupResult(Var Instr:TInstruction; operandnum: byte);
@ -1043,10 +1046,31 @@ end;
{$endif i386} {$endif i386}
Procedure SetOperandSize(var instr:TInstruction;operandnum,size:longint);
begin
{ the current size is NOT overriden if it already }
{ exists, such as in the case of a byte ptr, in }
{ front of the identifier. }
if (instr.operands[operandnum].size = S_NO) or (instr.operands[operandnum].overriden = FALSE) then
Begin
case size of
1: instr.operands[operandnum].size := S_B;
2: instr.operands[operandnum].size := S_W{ could be S_IS};
4: instr.operands[operandnum].size := S_L{ could be S_IL or S_FS};
8: instr.operands[operandnum].size := S_IQ{ could be S_D or S_FL};
extended_size: instr.operands[operandnum].size := S_FX;
else
{ this is in the case where the instruction is LEA }
{ or something like that, in that case size is not }
{ important. }
instr.operands[operandnum].size := S_NO;
end; { end case }
end;
end;
Function GetVarOffset(var Instr: TInstruction;const base: string; const field: string;
Var Offset: longint; operandnum: byte):boolean; Function GetVarOffsetSize(const base,field:string;Var Offset: longint;var Size:longint):boolean;
{ search and returns the offset of records/objects of the base } { search and returns the offset and size of records/objects of the base }
{ with field name setup in field. } { with field name setup in field. }
{ returns FALSE if not found. } { returns FALSE if not found. }
{ used when base is a variable or a typed constant name. } { used when base is a variable or a typed constant name. }
@ -1054,7 +1078,7 @@ end;
sym:psym; sym:psym;
p: psym; p: psym;
Begin Begin
GetVarOffset := FALSE; GetVarOffsetSize := FALSE;
Offset := 0; Offset := 0;
{ local list } { local list }
if assigned(aktprocsym) then if assigned(aktprocsym) then
@ -1072,25 +1096,8 @@ end;
if assigned(pvarsym(p)) then if assigned(pvarsym(p)) then
Begin Begin
Offset := pvarsym(p)^.address; Offset := pvarsym(p)^.address;
{ the current size is NOT overriden if it already } Size:=PVarsym(p)^.getsize;
{ exists, such as in the case of a byte ptr, in } GetVarOffsetSize := TRUE;
{ front of the identifier. }
if (instr.operands[operandnum].size = S_NO) or (instr.operands[operandnum].overriden = FALSE) then
Begin
case pvarsym(p)^.getsize of
1: instr.operands[operandnum].size := S_B;
2: instr.operands[operandnum].size := S_W{ could be S_IS};
4: instr.operands[operandnum].size := S_L{ could be S_IL or S_FS};
8: instr.operands[operandnum].size := S_IQ{ could be S_D or S_FL};
extended_size: instr.operands[operandnum].size := S_FX;
else
{ this is in the case where the instruction is LEA }
{ or something like that, in that case size is not }
{ important. }
instr.operands[operandnum].size := S_NO;
end; { end case }
end;
GetVarOffset := TRUE;
Exit; Exit;
end; end;
end end
@ -1103,25 +1110,8 @@ end;
if assigned(pvarsym(p)) then if assigned(pvarsym(p)) then
Begin Begin
Offset := pvarsym(p)^.address; Offset := pvarsym(p)^.address;
{ the current size is NOT overriden if it already } Size:=PVarsym(p)^.getsize;
{ exists, such as in the case of a byte ptr, in } GetVarOffsetSize := TRUE;
{ front of the identifier. }
if (instr.operands[operandnum].size = S_NO) or (instr.operands[operandnum].overriden = FALSE) then
Begin
case pvarsym(p)^.getsize of
1: instr.operands[operandnum].size := S_B;
2: instr.operands[operandnum].size := S_W{ could be S_IS};
4: instr.operands[operandnum].size := S_L{ could be S_IL or S_FS};
8: instr.operands[operandnum].size := S_IQ{ could be S_D or S_FL};
extended_size: instr.operands[operandnum].size := S_FX;
else
{ this is in the case where the instruction is LEA }
{ or something like that, in that case size is not }
{ important. }
instr.operands[operandnum].size := S_NO;
end; { end case }
end;
GetVarOffset := TRUE;
Exit; Exit;
end; end;
end; end;
@ -1143,25 +1133,8 @@ end;
if assigned(p) then if assigned(p) then
Begin Begin
Offset := pvarsym(p)^.address; Offset := pvarsym(p)^.address;
GetVarOffset := TRUE; Size:=PVarsym(p)^.getsize;
{ the current size is NOT overriden if it already } GetVarOffsetSize := TRUE;
{ exists, such as in the case of a byte ptr, in }
{ front of the identifier. }
if (instr.operands[operandnum].size = S_NO) or (instr.operands[operandnum].overriden = FALSE) then
Begin
case pvarsym(p)^.getsize of
1: instr.operands[operandnum].size := S_B;
2: instr.operands[operandnum].size := S_W{ could be S_IS};
4: instr.operands[operandnum].size := S_L{ could be S_IL or S_FS};
8: instr.operands[operandnum].size := S_IQ{ could be S_D or S_FL};
extended_size: instr.operands[operandnum].size := S_FX;
else
{ this is in the case where the instruction is LEA }
{ or something like that, in that case size is not }
{ important. }
instr.operands[operandnum].size := S_NO;
end; { end case }
end;
Exit; Exit;
end; end;
end { endif } end { endif }
@ -1174,25 +1147,8 @@ end;
if assigned(pvarsym(p)) then if assigned(pvarsym(p)) then
Begin Begin
Offset := pvarsym(p)^.address; Offset := pvarsym(p)^.address;
{ the current size is NOT overriden if it already } Size:=PVarsym(p)^.getsize;
{ exists, such as in the case of a byte ptr, in } GetVarOffsetSize := TRUE;
{ front of the identifier. }
if (instr.operands[operandnum].size = S_NO) or (instr.operands[operandnum].overriden = FALSE) then
Begin
case pvarsym(p)^.getsize of
1: instr.operands[operandnum].size := S_B;
2: instr.operands[operandnum].size := S_W{ could be S_IS};
4: instr.operands[operandnum].size := S_L{ could be S_IL or S_FS};
8: instr.operands[operandnum].size := S_IQ{ could be S_D or S_FL};
extended_size: instr.operands[operandnum].size := S_FX;
else
{ this is in the case where the instruction is LEA }
{ or something like that, in that case size is not }
{ important. }
instr.operands[operandnum].size := S_NO;
end; { end case }
end;
GetVarOffset := TRUE;
Exit; Exit;
end; end;
end; end;
@ -1213,25 +1169,8 @@ end;
if assigned(p) then if assigned(p) then
Begin Begin
Offset := pvarsym(p)^.address; Offset := pvarsym(p)^.address;
GetVarOffset := TRUE; Size:=PVarsym(p)^.getsize;
{ the current size is NOT overriden if it already } GetVarOffsetSize := TRUE;
{ exists, such as in the case of a byte ptr, in }
{ front of the identifier. }
if (instr.operands[operandnum].size = S_NO) or (instr.operands[operandnum].overriden = FALSE) then
Begin
case pvarsym(p)^.getsize of
1: instr.operands[operandnum].size := S_B;
2: instr.operands[operandnum].size := S_W{ could be S_IS};
4: instr.operands[operandnum].size := S_L{ could be S_IL or S_FS};
8: instr.operands[operandnum].size := S_IQ{ could be S_D or S_FL};
extended_size: instr.operands[operandnum].size := S_FX;
else
{ this is in the case where the instruction is LEA }
{ or something like that, in that case size is not }
{ important. }
instr.operands[operandnum].size := S_NO;
end; { end case }
end;
Exit; Exit;
end; end;
end end
@ -1244,25 +1183,8 @@ end;
if assigned(p) then if assigned(p) then
Begin Begin
Offset := pvarsym(p)^.address; Offset := pvarsym(p)^.address;
GetVarOffset := TRUE; Size:=PVarsym(p)^.getsize;
{ the current size is NOT overriden if it already } GetVarOffsetSize := TRUE;
{ exists, such as in the case of a byte ptr, in }
{ front of the identifier. }
if (instr.operands[operandnum].size = S_NO) or (instr.operands[operandnum].overriden = FALSE) then
Begin
case pvarsym(p)^.getsize of
1: instr.operands[operandnum].size := S_B;
2: instr.operands[operandnum].size := S_W{ could be S_IS};
4: instr.operands[operandnum].size := S_L{ could be S_IL or S_FS};
8: instr.operands[operandnum].size := S_IQ{ could be S_D or S_FL};
extended_size: instr.operands[operandnum].size := S_FX;
else
{ this is in the case where the instruction is LEA }
{ or something like that, in that case size is not }
{ important. }
instr.operands[operandnum].size := S_NO;
end; { end case }
end;
Exit; Exit;
end; end;
end end
@ -1275,25 +1197,8 @@ end;
if assigned(pvarsym(p)) then if assigned(pvarsym(p)) then
Begin Begin
Offset := pvarsym(p)^.address; Offset := pvarsym(p)^.address;
{ the current size is NOT overriden if it already } Size:=PVarsym(p)^.getsize;
{ exists, such as in the case of a byte ptr, in } GetVarOffsetSize := TRUE;
{ front of the identifier. }
if (instr.operands[operandnum].size = S_NO) or (instr.operands[operandnum].overriden = FALSE) then
Begin
case pvarsym(p)^.getsize of
1: instr.operands[operandnum].size := S_B;
2: instr.operands[operandnum].size := S_W{ could be S_IS};
4: instr.operands[operandnum].size := S_L{ could be S_IL or S_FS};
8: instr.operands[operandnum].size := S_IQ{ could be S_D or S_FL};
extended_size: instr.operands[operandnum].size := S_FX;
else
{ this is in the case where the instruction is LEA }
{ or something like that, in that case size is not }
{ important. }
instr.operands[operandnum].size := S_NO;
end; { end case }
end;
GetVarOffset := TRUE;
Exit; Exit;
end; end;
end; end;
@ -1303,8 +1208,7 @@ end;
Function GetTypeOffset(var instr: TInstruction; const base: string; const field: string; Function GetTypeOffsetSize(const base,field: string;Var Offset: longint;var Size:longint):boolean;
Var Offset: longint; operandnum: byte):boolean;
{ search and returns the offset of records/objects of the base } { search and returns the offset of records/objects of the base }
{ with field name setup in field. } { with field name setup in field. }
{ returns 0 if not found. } { returns 0 if not found. }
@ -1314,7 +1218,7 @@ end;
p: psym; p: psym;
Begin Begin
Offset := 0; Offset := 0;
GetTypeOffset := FALSE; GetTypeOffsetSize := FALSE;
{ local list } { local list }
if assigned(aktprocsym) then if assigned(aktprocsym) then
begin begin
@ -1331,25 +1235,8 @@ end;
if assigned(p) then if assigned(p) then
Begin Begin
Offset := pvarsym(p)^.address; Offset := pvarsym(p)^.address;
{ the current size is NOT overriden if it already } Size:=PVarsym(p)^.getsize;
{ exists, such as in the case of a byte ptr, in } GetTypeOffsetSize := TRUE;
{ front of the identifier. }
if (instr.operands[operandnum].size = S_NO) or (instr.operands[operandnum].overriden = FALSE) then
Begin
case pvarsym(p)^.getsize of
1: instr.operands[operandnum].size := S_B;
2: instr.operands[operandnum].size := S_W{ could be S_IS};
4: instr.operands[operandnum].size := S_L{ could be S_IL or S_FS};
8: instr.operands[operandnum].size := S_IQ{ could be S_D or S_FL};
extended_size: instr.operands[operandnum].size := S_FX;
else
{ this is in the case where the instruction is LEA }
{ or something like that, in that case size is not }
{ important. }
instr.operands[operandnum].size := S_NO;
end; { end case }
end;
GetTypeOffset := TRUE;
Exit; Exit;
end; end;
end; end;
@ -1370,25 +1257,7 @@ end;
if assigned(p) then if assigned(p) then
Begin Begin
Offset := pvarsym(p)^.address; Offset := pvarsym(p)^.address;
{ the current size is NOT overriden if it already } GetTypeOffsetSize := TRUE;
{ exists, such as in the case of a byte ptr, in }
{ front of the identifier. }
if (instr.operands[operandnum].size = S_NO) or (instr.operands[operandnum].overriden = FALSE) then
Begin
case pvarsym(p)^.getsize of
1: instr.operands[operandnum].size := S_B;
2: instr.operands[operandnum].size := S_W{ could be S_IS};
4: instr.operands[operandnum].size := S_L{ could be S_IL or S_FS};
8: instr.operands[operandnum].size := S_IQ{ could be S_D or S_FL};
extended_size: instr.operands[operandnum].size := S_FX;
else
{ this is in the case where the instruction is LEA }
{ or something like that, in that case size is not }
{ important. }
instr.operands[operandnum].size := S_NO;
end; { end case }
end;
GetTypeOffset := TRUE;
Exit; Exit;
end; end;
end; { endif } end; { endif }
@ -1408,25 +1277,8 @@ end;
if assigned(p) then if assigned(p) then
Begin Begin
Offset := pvarsym(p)^.address; Offset := pvarsym(p)^.address;
{ the current size is NOT overriden if it already } Size:=PVarsym(p)^.getsize;
{ exists, such as in the case of a byte ptr, in } GetTypeOffsetSize := TRUE;
{ front of the identifier. }
if (instr.operands[operandnum].size = S_NO) or (instr.operands[operandnum].overriden = FALSE) then
Begin
case pvarsym(p)^.getsize of
1: instr.operands[operandnum].size := S_B;
2: instr.operands[operandnum].size := S_W{ could be S_IS};
4: instr.operands[operandnum].size := S_L{ could be S_IL or S_FS};
8: instr.operands[operandnum].size := S_IQ{ could be S_D or S_FL};
extended_size: instr.operands[operandnum].size := S_FX;
else
{ this is in the case where the instruction is LEA }
{ or something like that, in that case size is not }
{ important. }
instr.operands[operandnum].size := S_NO;
end; { end case }
end;
GetTypeOffset := TRUE;
Exit; Exit;
end end
end end
@ -1440,25 +1292,8 @@ end;
if assigned(p) then if assigned(p) then
Begin Begin
Offset := pvarsym(p)^.address; Offset := pvarsym(p)^.address;
{ the current size is NOT overriden if it already } Size:=PVarsym(p)^.getsize;
{ exists, such as in the case of a byte ptr, in } GetTypeOffsetSize := TRUE;
{ front of the identifier. }
if instr.operands[operandnum].size = S_NO then
Begin
case pvarsym(p)^.getsize of
1: instr.operands[operandnum].size := S_B;
2: instr.operands[operandnum].size := S_W{ could be S_IS};
4: instr.operands[operandnum].size := S_L{ could be S_IL or S_FS};
8: instr.operands[operandnum].size := S_IQ{ could be S_D or S_FL};
extended_size: instr.operands[operandnum].size := S_FX;
else
{ this is in the case where the instruction is LEA }
{ or something like that, in that case size is not }
{ important. }
instr.operands[operandnum].size := S_NO;
end; { end case }
end;
GetTypeOffset := TRUE;
Exit; Exit;
end end
end; end;
@ -1487,7 +1322,6 @@ end;
if assigned(sym) then if assigned(sym) then
begin begin
case sym^.typ of case sym^.typ of
typedconstsym,
varsym : begin varsym : begin
{ we always assume in asm statements that } { we always assume in asm statements that }
{ that the variable is valid. } { that the variable is valid. }
@ -1525,6 +1359,31 @@ end;
CreateVarInstr := TRUE; CreateVarInstr := TRUE;
Exit; Exit;
end; end;
typedconstsym : begin
{ we always assume in asm statements that }
{ that the variable is valid. }
if assigned(instr.operands[operandnum].ref.symbol) then
FreeMem(instr.operands[operandnum].ref.symbol,length(instr.operands[operandnum].ref.symbol^)+1);
instr.operands[operandnum].ref.symbol:=newpasstr(pvarsym(sym)^.mangledname);
{ the current size is NOT overriden if it already }
{ exists, such as in the case of a byte ptr, in }
{ front of the identifier. }
if (instr.operands[operandnum].size = S_NO) or (instr.operands[operandnum].overriden = FALSE) then
Begin
case ptypedconstsym(sym)^.getsize of
1: instr.operands[operandnum].size := S_B;
2: instr.operands[operandnum].size := S_W{ could be S_IS};
4: instr.operands[operandnum].size := S_L{ could be S_IL or S_FS};
8: instr.operands[operandnum].size := S_IQ{ could be S_D or S_FL};
extended_size: instr.operands[operandnum].size := S_FX;
else
instr.operands[operandnum].size := S_NO;
end; { end case }
end;
{ ok, finished for this var }
CreateVarInstr := TRUE;
Exit;
end;
constsym : begin constsym : begin
if pconstsym(sym)^.consttype in [constint,constchar,constbool] then if pconstsym(sym)^.consttype in [constint,constchar,constbool] then
begin begin
@ -1534,6 +1393,15 @@ end;
Exit; Exit;
end; end;
end; end;
typesym : begin
if ptypesym(sym)^.definition^.deftype in [recorddef,objectdef] then
begin
instr.operands[operandnum].operandtype:=OPR_CONSTANT;
instr.operands[operandnum].val:=0;
CreateVarInstr := TRUE;
Exit;
end;
end;
procsym : begin procsym : begin
{ free the memory before changing the symbol name. } { free the memory before changing the symbol name. }
if assigned(instr.operands[operandnum].ref.symbol) then if assigned(instr.operands[operandnum].ref.symbol) then
@ -1653,6 +1521,15 @@ end;
Exit; Exit;
end; end;
end; end;
typesym : begin
if ptypesym(sym)^.definition^.deftype in [recorddef,objectdef] then
begin
instr.operands[operandnum].operandtype:=OPR_CONSTANT;
instr.operands[operandnum].val:=0;
CreateVarInstr := TRUE;
Exit;
end;
end;
procsym : begin procsym : begin
if assigned(pprocsym(sym)^.definition^.nextoverloaded) then if assigned(pprocsym(sym)^.definition^.nextoverloaded) then
Message(assem_w_calling_overload_func); Message(assem_w_calling_overload_func);
@ -1902,7 +1779,13 @@ end;
end. end.
{ {
$Log$ $Log$
Revision 1.13 1998-10-28 00:08:45 peter Revision 1.14 1998-11-05 23:48:17 peter
* recordtype.field support in constant expressions
* fixed imul for oa_imm8 which was not allowed
* fixed reading of local typed constants
* fixed comment reading which is not any longer a separator
Revision 1.13 1998/10/28 00:08:45 peter
+ leal procsym,eax is now allowed + leal procsym,eax is now allowed
+ constants are now handled also when starting an expression + constants are now handled also when starting an expression
+ call *pointer is now allowed + call *pointer is now allowed

11
compiler/i386.pas
View File

@ -568,7 +568,8 @@ unit i386;
(i : A_IMUL;ops : 3;oc : $69;eb : ao_none;m : Modrm or af_reverseregregmem;o1 : ao_imm16 or ao_imm32; (i : A_IMUL;ops : 3;oc : $69;eb : ao_none;m : Modrm or af_reverseregregmem;o1 : ao_imm16 or ao_imm32;
o2 : ao_wordreg or ao_mem;o3 : ao_wordreg), o2 : ao_wordreg or ao_mem;o3 : ao_wordreg),
(i : A_IMUL;ops : 2;oc : $6b;eb : ao_none;m : Modrm or imulKludge;o1 : ao_imm8s;o2 : ao_wordreg;o3 : 0), (i : A_IMUL;ops : 2;oc : $6b;eb : ao_none;m : Modrm or imulKludge;o1 : ao_imm8s;o2 : ao_wordreg;o3 : 0),
(i : A_IMUL;ops : 2;oc : $69;eb : ao_none;m : Modrm or imulKludge;o1 : ao_imm16 or ao_imm32;o2 : ao_wordreg;o3 : 0), (i : A_IMUL;ops : 2;oc : $69;eb : ao_none;m : Modrm or imulKludge;o1 : ao_imm8 or ao_imm16 or ao_imm32;
o2 : ao_wordreg;o3 : 0),
(i : A_DIV;ops : 1;oc : $f6;eb : 6;m : af_w or Modrm;o1 : ao_reg or ao_mem;o2 : 0;o3 : 0), (i : A_DIV;ops : 1;oc : $f6;eb : 6;m : af_w or Modrm;o1 : ao_reg or ao_mem;o2 : 0;o3 : 0),
(i : A_DIV;ops : 2;oc : $f6;eb : 6;m : af_w or Modrm;o1 : ao_reg or ao_mem;o2 : ao_acc;o3 : 0), (i : A_DIV;ops : 2;oc : $f6;eb : 6;m : af_w or Modrm;o1 : ao_reg or ao_mem;o2 : ao_acc;o3 : 0),
(i : A_IDIV;ops : 1;oc : $f6;eb : 7;m : af_w or Modrm;o1 : ao_reg or ao_mem;o2 : 0;o3 : 0), (i : A_IDIV;ops : 1;oc : $f6;eb : 7;m : af_w or Modrm;o1 : ao_reg or ao_mem;o2 : 0;o3 : 0),
@ -1724,7 +1725,13 @@ unit i386;
end. end.
{ {
$Log$ $Log$
Revision 1.14 1998-10-28 00:08:47 peter Revision 1.15 1998-11-05 23:48:20 peter
* recordtype.field support in constant expressions
* fixed imul for oa_imm8 which was not allowed
* fixed reading of local typed constants
* fixed comment reading which is not any longer a separator
Revision 1.14 1998/10/28 00:08:47 peter
+ leal procsym,eax is now allowed + leal procsym,eax is now allowed
+ constants are now handled also when starting an expression + constants are now handled also when starting an expression
+ call *pointer is now allowed + call *pointer is now allowed

1
compiler/msgidx.inc
View File

@ -398,6 +398,7 @@ type tmsgconst=(
assem_f_too_many_asm_files, assem_f_too_many_asm_files,
assem_f_assembler_output_not_supported, assem_f_assembler_output_not_supported,
assem_e_unsupported_symbol_type, assem_e_unsupported_symbol_type,
assem_e_cannot_index_relative_var,
exec_w_source_os_redefined, exec_w_source_os_redefined,
exec_i_assembling_pipe, exec_i_assembling_pipe,
exec_d_cant_create_asmfile, exec_d_cant_create_asmfile,

135
compiler/msgtxt.inc
View File

@ -1,4 +1,4 @@
const msgtxt : array[0..00094,1..240] of char=(+ const msgtxt : array[0..00094,1..240] of char=(
'T_Compiler: $1'#000+ 'T_Compiler: $1'#000+
'D_Source OS: $1'#000+ 'D_Source OS: $1'#000+
'I_Target OS: $1'#000+ 'I_Target OS: $1'#000+
@ -412,33 +412,34 @@ const msgtxt : array[0..00094,1..240] of char=(+
'F_Too many assembler files'#000+ 'F_Too many assembler files'#000+
'F_Selected assembler',' output not supported'#000+ 'F_Selected assembler',' output not supported'#000+
'E_Unsupported symbol type for operand'#000+ 'E_Unsupported symbol type for operand'#000+
'E_Cannot index a local var or parameter with a register'#000+
'W_Source operating system redefined'#000+ 'W_Source operating system redefined'#000+
'I_Assembling (pipe) $1'#000+ 'I_Assembling (pipe) $1'#000+
'E_Can'#039't create assember file $1'#000+ 'E_Can'#039't create assember file $1'#000+
'W_Assembler $1 not found, switching to external assembling'#000+ 'W_Assembler $1 not found, switchi','ng to external assembling'#000+
'T_Using assembler: $1'#000+ 'T_Using assembler: $1'#000+
'W_Error ','while assembling exitcode $1'#000+ 'W_Error while assembling exitcode $1'#000+
'W_Can'#039't call the assembler, error $1 switching to external assembl'+ 'W_Can'#039't call the assembler, error $1 switching to external assembl'+
'ing'#000+ 'ing'#000+
'I_Assembling $1'#000+ 'I_Assembling $1'#000+
'W_Linker $1 not found, switching to external linking'#000+ 'W_Linker $1 not found, switching to external linking'#000+
'T_Using linker: $1'#000+ 'T_Using linker: ','$1'#000+
'W_Object $1 not found, Linking may fail !'#000+ 'W_Object $1 not found, Linking may fail !'#000+
'W_Library $','1 not found, Linking may fail !'#000+ 'W_Library $1 not found, Linking may fail !'#000+
'W_Error while linking'#000+ 'W_Error while linking'#000+
'W_Can'#039't call the linker, switching to external linking'#000+ 'W_Can'#039't call the linker, switching to external linking'#000+
'I_Linking $1'#000+ 'I_Linking $1'#000+
'W_binder not found, switching to external binding'#000+ 'W_binder not found, switching to external binding'#000+
'W_ar not found, switching to external ar'#000+ 'W_ar not fou','nd, switching to external ar'#000+
'E_Dynamic Libraries not sup','ported'#000+ 'E_Dynamic Libraries not supported'#000+
'I_Closing script $1'#000+ 'I_Closing script $1'#000+
'F_Can'#039't post process executable $1'#000+ 'F_Can'#039't post process executable $1'#000+
'F_Can'#039't open executable $1'#000+ 'F_Can'#039't open executable $1'#000+
'X_Size of Code: $1 bytes'#000+ 'X_Size of Code: $1 bytes'#000+
'X_Size of initialized data: $1 bytes'#000+ 'X_Size of initialized data: $1 bytes'#000+
'X_Size of uninitialized data: $1 bytes'#000+ 'X_Size of uninitialized data: $1 ','bytes'#000+
'X_Stack space reserved: $1 bytes'#000+ 'X_Stack space reserved: $1 bytes'#000+
'X_Stack space com','mited: $1 bytes'#000+ 'X_Stack space commited: $1 bytes'#000+
'T_Unitsearch: $1'#000+ 'T_Unitsearch: $1'#000+
'T_PPU Loading $1'#000+ 'T_PPU Loading $1'#000+
'U_PPU Name: $1'#000+ 'U_PPU Name: $1'#000+
@ -447,8 +448,8 @@ const msgtxt : array[0..00094,1..240] of char=(+
'U_PPU Time: $1'#000+ 'U_PPU Time: $1'#000+
'U_PPU File too short'#000+ 'U_PPU File too short'#000+
'U_PPU Invalid Header (no PPU at the begin)'#000+ 'U_PPU Invalid Header (no PPU at the begin)'#000+
'U_PPU Invalid Version $1'#000+ 'U_PPU Inva','lid Version $1'#000+
'U_PPU is compiled for an other processor'#000,+ 'U_PPU is compiled for an other processor'#000+
'U_PPU is compiled for an other target'#000+ 'U_PPU is compiled for an other target'#000+
'U_PPU Source: $1'#000+ 'U_PPU Source: $1'#000+
'U_Writing $1'#000+ 'U_Writing $1'#000+
@ -456,181 +457,181 @@ const msgtxt : array[0..00094,1..240] of char=(+
'F_reading PPU-File'#000+ 'F_reading PPU-File'#000+
'F_unexpected end of PPU-File'#000+ 'F_unexpected end of PPU-File'#000+
'F_Invalid PPU-File entry: $1'#000+ 'F_Invalid PPU-File entry: $1'#000+
'F_PPU Dbx count problem'#000+ 'F_PPU Dbx count ','problem'#000+
'E_Illegal unit name: $1'#000+ 'E_Illegal unit name: $1'#000+
'F_Too much units'#000+ 'F_Too much units'#000+
'F_Circu','lar unit reference between $1 and $2'#000+ 'F_Circular unit reference between $1 and $2'#000+
'F_Can'#039't compile unit $1, no sources available'#000+ 'F_Can'#039't compile unit $1, no sources available'#000+
'W_Compiling the system unit requires the -Us switch'#000+ 'W_Compiling the system unit requires the -Us switch'#000+
'F_There were $1 errors compiling module, stopping'#000+ 'F_There were $1 errors compiling module, stopping',#000+
'U_Load from $1 ($2) unit $3'#000+ 'U_Load from $1 ($2) unit $3'#000+
'U_Recompiling $1, checksum ','changed for $2'#000+ 'U_Recompiling $1, checksum changed for $2'#000+
'U_Recompiling unit, static lib is older than ppufile'#000+ 'U_Recompiling unit, static lib is older than ppufile'#000+
'U_Recompiling unit, shared lib is older than ppufile'#000+ 'U_Recompiling unit, shared lib is older than ppufile'#000+
'U_Recompiling unit, obj and asm are older than ppufile'#000+ 'U_Recompiling unit, obj and asm are older than ppufile'#000+
'U_Recompiling unit, obj is older than asm'#000+ 'U_Recomp','iling unit, obj is older than asm'#000+
'U_Parsing interface of',' $1'#000+ 'U_Parsing interface of $1'#000+
'U_Parsing implementation of $1'#000+ 'U_Parsing implementation of $1'#000+
'U_Second load for unit $1'#000+ 'U_Second load for unit $1'#000+
'U_PPU Check file $1 time $2'#000+ 'U_PPU Check file $1 time $2'#000+
'$1 [options] <inputfile> [options]'#000+ '$1 [options] <inputfile> [options]'#000+
'W_Only one source file supported'#000+ 'W_Only one source file supported'#000+
'W_DEF file can be created only for OS/2'#000+ 'W_DEF file can be created o','nly for OS/2'#000+
'E_nested response files are not supported'#000+ 'E_nested response files are not supported'#000+
'F','_No source file name in command line'#000+ 'F_No source file name in command line'#000+
'E_Illegal parameter: $1'#000+ 'E_Illegal parameter: $1'#000+
'H_-? writes help pages'#000+ 'H_-? writes help pages'#000+
'F_Too many config files nested'#000+ 'F_Too many config files nested'#000+
'F_Unable to open file $1'#000+ 'F_Unable to open file $1'#000+
'N_Reading further options from $1'#000+ 'N_Reading further options from $1'#000+
'W_Target is already set to: $1'#000+ 'W_Target i','s already set to: $1'#000+
'W_Shared libs not supported on DOS ','platform, reverting to static'#000+ 'W_Shared libs not supported on DOS platform, reverting to static'#000+
'F_too many IF(N)DEFs'#000+ 'F_too many IF(N)DEFs'#000+
'F_too many ENDIFs'#000+ 'F_too many ENDIFs'#000+
'F_open conditional at the end of the file'#000+ 'F_open conditional at the end of the file'#000+
'W_Debug information generation is not supported by this executable'#000+ 'W_Debug information generation is not supported by this executable'#000+
'H_Try recompiling with -dGDB'#000+ 'H_Try ','recompiling with -dGDB'#000+
'W_You are using the obsolete swit','ch $1'#000+ 'W_You are using the obsolete switch $1'#000+
'Free Pascal Compiler version $FPCVER [$FPCDATE] for $FPCTARGET'#000+ 'Free Pascal Compiler version $FPCVER [$FPCDATE] for $FPCTARGET'#000+
'Copyright (c) 1993-98 by Florian Klaempfl'#000+ 'Copyright (c) 1993-98 by Florian Klaempfl'#000+
'Free Pascal Compiler version $FPCVER'#000+ 'Free Pascal Compiler version $FPCVER'#000+
#000+ #000+
'Compiler Date : $FPCDATE'#000+ 'Compiler Date : $FPCDATE'#000+
'Compiler Target: $FPCTARGET'#000+ 'Compiler ','Target: $FPCTARGET'#000+
#000+ #000+
'This program comes under the GNU Gen','eral Public Licence'#000+ 'This program comes under the GNU General Public Licence'#000+
'For more information read COPYING.FPC'#000+ 'For more information read COPYING.FPC'#000+
#000+ #000+
'Report bugs,suggestions etc to:'#000+ 'Report bugs,suggestions etc to:'#000+
' fpc-devel@mail.tolna.hungary.net'#000+ ' fpc-devel@mail.tolna.hungary.net'#000+
'**0*_put + after a boolean switch option to enable it, - to disable it'+ '**0*_put + after a boolean switch option to ','enable it, - to disable '+
#000+ 'it'#000+
'**1a_the compiler doesn'#039't del','ete the generated assembler file'#000+ '**1a_the compiler doesn'#039't delete the generated assembler file'#000+
'**2al_list sourcecode lines in assembler file'#000+ '**2al_list sourcecode lines in assembler file'#000+
'*t1b_use EMS'#000+ '*t1b_use EMS'#000+
'**1B_build all modules'#000+ '**1B_build all modules'#000+
'**1C_code generation options'#000+ '**1C_code generation options'#000+
'3*2CD_create dynamic library'#000+ '3*2CD_create dynamic library'#000+
'**2Ch<n>_<n> bytes heap (between 1023 and 67107840)'#000+ '**2Ch<n>_<n','> bytes heap (between 1023 and 67107840)'#000+
'**2Ci_IO-checki','ng'#000+ '**2Ci_IO-checking'#000+
'**2Cn_omit linking stage'#000+ '**2Cn_omit linking stage'#000+
'**2Co_check overflow of integer operations'#000+ '**2Co_check overflow of integer operations'#000+
'**2Cr_range checking'#000+ '**2Cr_range checking'#000+
'**2Cs<n>_set stack size to <n>'#000+ '**2Cs<n>_set stack size to <n>'#000+
'**2Ct_stack checking'#000+ '**2Ct_stack checking'#000+
'3*2CS_create static library'#000+ '3*2CS_create static library'#000+
'3*2Cx_use smartlinking'#000+ '3*2Cx_use sm','artlinking'#000+
'**1d<x>_defines the symbol <x>'#000+ '**1d<x>_defines the symbol <x>'#000+
'*O1D_generate ','a DEF file'#000+ '*O1D_generate a DEF file'#000+
'*O2Dd<x>_set description to <x>'#000+ '*O2Dd<x>_set description to <x>'#000+
'*O2Dw_PM application'#000+ '*O2Dw_PM application'#000+
'**1e<x>_set path to executable'#000+ '**1e<x>_set path to executable'#000+
'**1E_same as -Cn'#000+ '**1E_same as -Cn'#000+
'**1F_set file names and paths'#000+ '**1F_set file names and paths'#000+
'**2FD<x>_sets the directory where to search for compiler utilities'#000+ '**2FD<x>_sets the directory where to searc','h for compiler utilities'#000+
'**2Fe<x>_redirect error output ','to <x>'#000+ '**2Fe<x>_redirect error output to <x>'#000+
'**2FE<x>_set exe/unit output path to <x>'#000+ '**2FE<x>_set exe/unit output path to <x>'#000+
'*L2Fg<x>_same as -Fl'#000+ '*L2Fg<x>_same as -Fl'#000+
'**2Fi<x>_adds <x> to include path'#000+ '**2Fi<x>_adds <x> to include path'#000+
'**2Fl<x>_adds <x> to library path'#000+ '**2Fl<x>_adds <x> to library path'#000+
'*L2FL<x>_uses <x> as dynamic linker'#000+ '*L2FL<x>_uses <x> as dynamic linker'#000+
'**2Fo<x>_adds <x> to object path'#000+ '**2Fo<x>_ad','ds <x> to object path'#000+
'**2Fr<x>_load error message file <','x>'#000+ '**2Fr<x>_load error message file <x>'#000+
'**2Fu<x>_adds <x> to unit path'#000+ '**2Fu<x>_adds <x> to unit path'#000+
'**2FU<x>_set unit output path to <x>, overrides -FE'#000+ '**2FU<x>_set unit output path to <x>, overrides -FE'#000+
'*g1g_generate debugger information'#000+ '*g1g_generate debugger information'#000+
'*g2gg_use gsym'#000+ '*g2gg_use gsym'#000+
'*g2gd_use dbx'#000+ '*g2gd_use dbx'#000+
'**1i_information'#000+ '**1i_information'#000+
'**1I<x>_adds <x> to include path'#000+ '**1I<x>_adds <x> ','to include path'#000+
'**1k<x>_Pass <x> to the linker'#000+ '**1k<x>_Pass <x> to the linker'#000+
'**1l_writ','e logo'#000+ '**1l_write logo'#000+
'**1n_don'#039't read the default config file'#000+ '**1n_don'#039't read the default config file'#000+
'**1o<x>_change the name of the executable produced to <x>'#000+ '**1o<x>_change the name of the executable produced to <x>'#000+
'**1pg_generate profile code for gprof'#000+ '**1pg_generate profile code for gprof'#000+
'*L1P_use pipes instead of creating temporary assembler files'#000+ '*L1P_use pipes instead of creating tempor','ary assembler files'#000+
'**1S_syntax options'#000+ '**1S_syntax options'#000+
'**2S2_switch som','e Delphi 2 extensions on'#000+ '**2S2_switch some Delphi 2 extensions on'#000+
'**2Sc_supports operators like C (*=,+=,/= and -=)'#000+ '**2Sc_supports operators like C (*=,+=,/= and -=)'#000+
'**2Sd_tries to be Delphi compatible'#000+ '**2Sd_tries to be Delphi compatible'#000+
'**2Se_compiler stops after the first error'#000+ '**2Se_compiler stops after the first error'#000+
'**2Sg_allow LABEL and GOTO'#000+ '**2Sg_allow LABEL and GOTO'#000+
'**2Si_support C++ stlyed INLINE'#000+ '**2','Si_support C++ stlyed INLINE'#000+
'**2Sm_support macros like C',' (global)'#000+ '**2Sm_support macros like C (global)'#000+
'**2So_tries to be TP/BP 7.0 compatible'#000+ '**2So_tries to be TP/BP 7.0 compatible'#000+
'**2Sp_tries to be gpc compatible'#000+ '**2Sp_tries to be gpc compatible'#000+
'**2Ss_constructor name must be init (destructor must be done)'#000+ '**2Ss_constructor name must be init (destructor must be done)'#000+
'**2St_allow static keyword in objects'#000+ '**2St_allow static keyword in objects'#000+
'**1s_don'#039't call assembler and linker (only with -a)'#000+ '**','1s_don'#039't call assembler and linker (only with -a)'#000+
'**1u<x','>_undefines the symbol <x>'#000+ '**1u<x>_undefines the symbol <x>'#000+
'**1U_unit options'#000+ '**1U_unit options'#000+
'**2Un_don'#039't check the unit name'#000+ '**2Un_don'#039't check the unit name'#000+
'**2Up<x>_same as -Fu<x>'#000+ '**2Up<x>_same as -Fu<x>'#000+
'**2Us_compile a system unit'#000+ '**2Us_compile a system unit'#000+
'**1v<x>_Be verbose. <x> is a combination of the following letters :'#000+ '**1v<x>_Be verbose. <x> is a combination of the followi','ng letters :'#000+
'**2*_e : Show errors (default) d : Sh','ow debug info'#000+ '**2*_e : Show errors (default) d : Show debug info'#000+
'**2*_w : Show warnings u : Show unit info'#000+ '**2*_w : Show warnings u : Show unit info'#000+
'**2*_n : Show notes t : Show tried/used files'#000+ '**2*_n : Show notes t : Show tried/used files'#000+
'**2*_h : Show hints m : Show defined macros'#000+ '**2*_h : Show hints m : Show defin','ed macros'#000+
'**2*_i : Show general info p : Show ','compiled procedures'#000+ '**2*_i : Show general info p : Show compiled procedures'#000+
'**2*_l : Show linenumbers c : Show conditionals'#000+ '**2*_l : Show linenumbers c : Show conditionals'#000+
'**2*_a : Show everything 0 : Show nothing (except errors)'#000+ '**2*_a : Show everything 0 : Show nothing (except errors)'#000+
'**2*_b : Show all procedure r : Rhide/GCC compatibility mode'#000+ '**2*_b : Show all procedure ',' r : Rhide/GCC compatibility mod'+
'**2*_ declarations',' if an error x : Executable info (Win32 only'+ 'e'#000+
')'#000+ '**2*_ declarations if an error x : Executable info (Win32 only)'#000+
'**2*_ occurs'#000+ '**2*_ occurs'#000+
'**1X_executable options'#000+ '**1X_executable options'#000+
'*L2Xc_link with the c library'#000+ '*L2Xc_link with the c library'#000+
'**2XD_link with dynamic libraries (defines FPC_LINK_DYNAMIC)'#000+ '**2XD_link with dynamic libraries (defines FPC_LINK_DYNAMIC)'#000+
'**2Xs_strip all symbols from executable'#000+ '**2X','s_strip all symbols from executable'#000+
'**2XS_link with stat','ic libraries (defines FPC_LINK_STATIC)'#000+ '**2XS_link with static libraries (defines FPC_LINK_STATIC)'#000+
'**0*_Processor specific options:'#000+ '**0*_Processor specific options:'#000+
'3*1A<x>_output format'#000+ '3*1A<x>_output format'#000+
'3*2Ao_coff file using GNU AS'#000+ '3*2Ao_coff file using GNU AS'#000+
'3*2Anasmcoff_coff file using Nasm'#000+ '3*2Anasmcoff_coff file using Nasm'#000+
'3*2Anasmelf_elf32 (linux) file using Nasm'#000+ '3*2Anasmelf_elf32 (linux) f','ile using Nasm'#000+
'3*2Anasmobj_obj file using Nasm'#000+ '3*2Anasmobj_obj file using Nasm'#000+
'3*2Amasm_','obj using Masm (Mircosoft)'#000+ '3*2Amasm_obj using Masm (Mircosoft)'#000+
'3*2Atasm_obj using Tasm (Borland)'#000+ '3*2Atasm_obj using Tasm (Borland)'#000+
'3*1R<x>_assembler reading style'#000+ '3*1R<x>_assembler reading style'#000+
'3*2Ratt_read AT&T style assembler'#000+ '3*2Ratt_read AT&T style assembler'#000+
'3*2Rintel_read Intel style assembler'#000+ '3*2Rintel_read Intel style assembler'#000+
'3*2Rdirect_copy assembler text directly to assembler file'#000+ '3*2Rdirect_copy asse','mbler text directly to assembler file'#000+
'3*1O<x>_optimizati','ons'#000+ '3*1O<x>_optimizations'#000+
'3*2Og_generate smaller code'#000+ '3*2Og_generate smaller code'#000+
'3*2OG_generate faster code (default)'#000+ '3*2OG_generate faster code (default)'#000+
'3*2Or_keep certain variables in registers (still BUGGY!!!)'#000+ '3*2Or_keep certain variables in registers (still BUGGY!!!)'#000+
'3*2Ou_enable uncertain optimizations (see docs)'#000+ '3*2Ou_enable uncertain optimizations (see docs)'#000+
'3*2O1_level 1 optimizations (quick optimizations)'#000+ '3*2O1_le','vel 1 optimizations (quick optimizations)'#000+
'3*2O2_level 2 ','optimizations (-O1 + slower optimizations)'#000+ '3*2O2_level 2 optimizations (-O1 + slower optimizations)'#000+
'3*2O3_level 3 optimizations (same as -O2u)'#000+ '3*2O3_level 3 optimizations (same as -O2u)'#000+
'3*2Op_target processor'#000+ '3*2Op_target processor'#000+
'3*3Op1_set target processor to 386/486'#000+ '3*3Op1_set target processor to 386/486'#000+
'3*3Op2_set target processor to Pentium/PentiumMMX (tm)'#000+ '3*3Op2_set target processor to Penti','um/PentiumMMX (tm)'#000+
'3*3Op3_set target processor to PPro/P','II/c6x86/K6 (tm)'#000+ '3*3Op3_set target processor to PPro/PII/c6x86/K6 (tm)'#000+
'3*1T<x>_Target operating system'#000+ '3*1T<x>_Target operating system'#000+
'3*2TGO32V1_version 1 of DJ Delorie DOS extender'#000+ '3*2TGO32V1_version 1 of DJ Delorie DOS extender'#000+
'3*2TGO32V2_version 2 of DJ Delorie DOS extender'#000+ '3*2TGO32V2_version 2 of DJ Delorie DOS extender'#000+
'3*2TLINUX_Linux'#000+ '3*2TLINUX_Linux'#000+
'3*2TOS2_OS/2 2.x'#000+ '3*2TOS2_OS/2 2.x'#000+
'3*2TWin32_Windows 32 Bit'#000+ '3*2TWi','n32_Windows 32 Bit'#000+
'6*1A<x>_output format'#000+ '6*1A<x>_output format'#000+
'6*2Ao_Unix o-fi','le using GNU AS'#000+ '6*2Ao_Unix o-file using GNU AS'#000+
'6*2Agas_GNU Motorola assembler'#000+ '6*2Agas_GNU Motorola assembler'#000+
'6*2Amit_MIT Syntax (old GAS)'#000+ '6*2Amit_MIT Syntax (old GAS)'#000+
'6*2Amot_Standard Motorola assembler'#000+ '6*2Amot_Standard Motorola assembler'#000+
'6*1O_optimizations'#000+ '6*1O_optimizations'#000+
'6*2Oa_turn on the optimizer'#000+ '6*2Oa_turn on the optimizer'#000+
'6*2Og_generate smaller code'#000+ '6*2Og_generate smaller co','de'#000+
'6*2OG_generate faster code (default)'#000+ '6*2OG_generate faster code (default)'#000+
'6*2Ox_optimize m','aximum (still BUGGY!!!)'#000+ '6*2Ox_optimize maximum (still BUGGY!!!)'#000+
'6*2O2_set target processor to a MC68020+'#000+ '6*2O2_set target processor to a MC68020+'#000+
'6*1R<x>_assembler reading style'#000+ '6*1R<x>_assembler reading style'#000+
'6*2RMOT_read motorola style assembler'#000+ '6*2RMOT_read motorola style assembler'#000+
'6*1T<x>_Target operating system'#000+ '6*1T<x>_Target operating system'#000+
'6*2TAMIGA_Commodore Amiga'#000+ '6*2TAMIGA_Commodo','re Amiga'#000+
'6*2TATARI_Atari ST/STe/TT'#000+ '6*2TATARI_Atari ST/STe/TT'#000+
'6*2TMACOS_Macintosh m','68k'#000+ '6*2TMACOS_Macintosh m68k'#000+
'6*2TLINUX_Linux-68k'#000+ '6*2TLINUX_Linux-68k'#000+
'**1*_'#000+ '**1*_'#000+
'**1?_shows this help'#000+ '**1?_shows this help'#000+

198
compiler/ra386att.pas
View File

@ -1575,7 +1575,6 @@ const
end; end;
{ ------------------------------------------------------------------- } { ------------------------------------------------------------------- }
{ copy them to local variables } { copy them to local variables }
{ for faster access } { for faster access }
optyp1:=operands[1].opinfo; optyp1:=operands[1].opinfo;
@ -2419,6 +2418,62 @@ const
end; end;
Procedure GetRecordOffsetSize(const expr: string;var offset:longint;var size:longint);
{*********************************************************************}
{ PROCEDURE GetRecordOffsetSize }
{ Description: This routine builds up a record offset after a AS_DOT }
{ token is encountered. }
{ On entry actasmtoken should be equal to AS_DOT }
{*********************************************************************}
{ EXIT CONDITION: On exit the routine should point to either the }
{ AS_COMMA or AS_SEPARATOR token. }
{ Warning: This is called recursively. }
{*********************************************************************}
var
toffset,tsize : longint;
Begin
offset:=0;
size:=0;
Consume(AS_DOT);
if actasmtoken = AS_ID then
Begin
if not GetTypeOffsetSize(expr,actasmpattern,toffset,tsize) and
not GetVarOffsetSize(expr,actasmpattern,toffset,tsize) then
begin
Message(assem_e_syntax_error);
toffset:=0;
tsize:=0;
end;
inc(offset,toffset);
size:=tsize;
Consume(AS_ID);
case actasmtoken of
AS_SEPARATOR,
AS_COMMA : exit;
AS_DOT : begin
GetRecordOffsetSize(expr,toffset,tsize);
inc(offset,toffset);
size:=tsize;
end;
else
Begin
Message(assem_e_syntax_error);
repeat
consume(actasmtoken)
until (actasmtoken = AS_SEPARATOR) or (actasmtoken = AS_COMMA);
exit;
end;
end;
end
else
Begin
Message(assem_e_syntax_error);
repeat
consume(actasmtoken)
until (actasmtoken = AS_SEPARATOR) or (actasmtoken = AS_COMMA);
end;
end;
Function BuildExpression: longint; Function BuildExpression: longint;
@ -2437,7 +2492,7 @@ const
{*********************************************************************} {*********************************************************************}
var expr: string; var expr: string;
tempstr: string; tempstr: string;
l : longint; l,k : longint;
errorflag: boolean; errorflag: boolean;
Begin Begin
errorflag := FALSE; errorflag := FALSE;
@ -2498,14 +2553,25 @@ const
expr := expr + '|'; expr := expr + '|';
end; end;
AS_ID: Begin AS_ID: Begin
if NOT SearchIConstant(actasmpattern,l) then tempstr:=actasmpattern;
Begin previous_was_id:=TRUE;
Message1(assem_e_invalid_const_symbol,actasmpattern); consume(AS_ID);
l := 0; if actasmtoken=AS_DOT then
end; begin
GetRecordOffsetSize(tempstr,l,k);
str(l, tempstr); str(l, tempstr);
expr := expr + tempstr; expr := expr + tempstr;
Consume(AS_ID); end
else
begin
if SearchIConstant(actasmpattern,l) then
begin
str(l, tempstr);
expr := expr + tempstr;
end
else
Message1(assem_e_invalid_const_symbol,actasmpattern);
end;
end; end;
AS_INTNUM: Begin AS_INTNUM: Begin
expr := expr + actasmpattern; expr := expr + actasmpattern;
@ -2739,7 +2805,7 @@ const
{*********************************************************************} {*********************************************************************}
var tempstr: string; var tempstr: string;
expr: string; expr: string;
l : longint; l,k : longint;
errorflag : boolean; errorflag : boolean;
Begin Begin
errorflag := FALSE; errorflag := FALSE;
@ -2806,14 +2872,24 @@ const
end; end;
AS_ID: AS_ID:
Begin Begin
if NOT SearchIConstant(actasmpattern,l) then tempstr:=actasmpattern;
Begin consume(AS_ID);
Message1(assem_e_invalid_const_symbol,actasmpattern); if actasmtoken=AS_DOT then
l := 0; begin
end; GetRecordOffsetSize(tempstr,l,k);
str(l, tempstr); str(l, tempstr);
expr := expr + tempstr; expr := expr + tempstr;
Consume(AS_ID); end
else
begin
if SearchIConstant(actasmpattern,l) then
begin
str(l, tempstr);
expr := expr + tempstr;
end
else
Message1(assem_e_invalid_const_symbol,actasmpattern);
end;
end; end;
AS_INTNUM: Begin AS_INTNUM: Begin
expr := expr + actasmpattern; expr := expr + actasmpattern;
@ -2879,8 +2955,11 @@ const
Case actasmtoken of Case actasmtoken of
{ // (reg ... // } { // (reg ... // }
AS_REGISTER: Begin AS_REGISTER: Begin
instr.operands[operandnum].ref.base := { Check if there is already a base (mostly ebp,esp) than this is
findregister(actasmpattern); not allowed,becuase it will give crashing code }
if instr.operands[operandnum].ref.base<>R_NO then
Message(assem_e_cannot_index_relative_var);
instr.operands[operandnum].ref.base := findregister(actasmpattern);
Consume(AS_REGISTER); Consume(AS_REGISTER);
{ can either be a register or a right parenthesis } { can either be a register or a right parenthesis }
{ // (reg) // } { // (reg) // }
@ -3046,75 +3125,6 @@ const
end; end;
Procedure BuildRecordOffset(const expr: string; var Instr: TInstruction);
{*********************************************************************}
{ PROCEDURE BuildRecordOffset }
{ Description: This routine builds up a record offset after a AS_DOT }
{ token is encountered. }
{ On entry actasmtoken should be equal to AS_DOT }
{*********************************************************************}
{ EXIT CONDITION: On exit the routine should point to either the }
{ AS_COMMA or AS_SEPARATOR token. }
{ Warning: This is called recursively. }
{*********************************************************************}
var offset: longint;
Begin
Consume(AS_DOT);
if actasmtoken = AS_ID then
Begin
if GetTypeOffset(instr,expr,actasmpattern,offset,operandnum) then
begin
instr.operands[operandnum].ref.offset := instr.operands[operandnum].ref.offset + offset;
Consume(AS_ID);
case actasmtoken of
AS_SEPARATOR,AS_COMMA: exit;
{ one level deeper }
AS_DOT: BuildRecordOffset(expr,instr);
else
Begin
Message(assem_e_syntax_error);
repeat
consume(actasmtoken)
until (actasmtoken = AS_SEPARATOR) or (actasmtoken = AS_COMMA);
exit;
end;
end;
end
else
if GetVarOffset(instr,expr,actasmpattern,offset,operandnum) then
begin
instr.operands[operandnum].ref.offset := instr.operands[operandnum].ref.offset + offset;
Consume(AS_ID);
case actasmtoken of
AS_SEPARATOR,AS_COMMA: exit;
{ one level deeper }
AS_DOT: BuildRecordOffset(expr,instr);
else
Begin
Message(assem_e_syntax_error);
repeat
consume(actasmtoken)
until (actasmtoken = AS_SEPARATOR) or (actasmtoken = AS_COMMA);
exit;
end;
end;
end
else
Begin
Message(assem_e_syntax_error);
end;
end
else
Begin
Message(assem_e_syntax_error);
repeat
consume(actasmtoken)
until (actasmtoken = AS_SEPARATOR) or (actasmtoken = AS_COMMA);
end;
end;
Procedure BuildOperand(var instr: TInstruction); Procedure BuildOperand(var instr: TInstruction);
{*********************************************************************} {*********************************************************************}
{ EXIT CONDITION: On exit the routine should point to either the } { EXIT CONDITION: On exit the routine should point to either the }
@ -3125,6 +3135,8 @@ const
expr: string; expr: string;
lab: Pasmlabel; lab: Pasmlabel;
hl: plabel; hl: plabel;
tsize,
toffset : longint;
Begin Begin
tempstr := ''; tempstr := '';
expr := ''; expr := '';
@ -3271,7 +3283,7 @@ const
Message1(assem_e_unknown_id,actasmpattern); Message1(assem_e_unknown_id,actasmpattern);
end; end;
{ constant expression? } { constant expression? }
if instr.operands[operandnum].operandtype=OPR_CONSTANT then if (instr.operands[operandnum].operandtype=OPR_CONSTANT) then
instr.operands[operandnum].val := BuildExpression instr.operands[operandnum].val := BuildExpression
else else
begin begin
@ -3284,7 +3296,9 @@ const
BuildReference(instr); BuildReference(instr);
end; end;
AS_DOT : Begin AS_DOT : Begin
BuildRecordOffset(expr,instr); GetRecordOffsetSize(expr,toffset,tsize);
inc(instr.operands[operandnum].ref.offset,toffset);
SetOperandSize(instr,operandnum,tsize);
end; end;
AS_SEPARATOR,AS_COMMA: ; AS_SEPARATOR,AS_COMMA: ;
else else
@ -3875,7 +3889,13 @@ end.
{ {
$Log$ $Log$
Revision 1.17 1998-10-28 21:34:39 peter Revision 1.18 1998-11-05 23:48:26 peter
* recordtype.field support in constant expressions
* fixed imul for oa_imm8 which was not allowed
* fixed reading of local typed constants
* fixed comment reading which is not any longer a separator
Revision 1.17 1998/10/28 21:34:39 peter
* fixed some opsize * fixed some opsize
Revision 1.16 1998/10/28 00:08:48 peter Revision 1.16 1998/10/28 00:08:48 peter

127
compiler/ra386int.pas
View File

@ -2009,8 +2009,62 @@ var
Procedure GetRecordOffsetSize(const expr: string;var offset:longint;var size:longint);
{*********************************************************************}
{ PROCEDURE GetRecordOffsetSize }
{ Description: This routine builds up a record offset after a AS_DOT }
{ token is encountered. }
{ On entry actasmtoken should be equal to AS_DOT }
{*********************************************************************}
{ EXIT CONDITION: On exit the routine should point to either the }
{ AS_COMMA or AS_SEPARATOR token. }
{ Warning: This is called recursively. }
{*********************************************************************}
var
toffset,tsize : longint;
Begin
offset:=0;
size:=0;
Consume(AS_DOT);
if actasmtoken = AS_ID then
Begin
if not GetTypeOffsetSize(expr,actasmpattern,toffset,tsize) and
not GetVarOffsetSize(expr,actasmpattern,toffset,tsize) then
begin
Message(assem_e_syntax_error);
toffset:=0;
tsize:=0;
end;
inc(offset,toffset);
size:=tsize;
Consume(AS_ID);
case actasmtoken of
AS_SEPARATOR,
AS_COMMA : exit;
AS_DOT : begin
GetRecordOffsetSize(expr,toffset,tsize);
inc(offset,toffset);
size:=tsize;
end;
else
Begin
Message(assem_e_syntax_error);
repeat
consume(actasmtoken)
until (actasmtoken = AS_SEPARATOR) or (actasmtoken = AS_COMMA);
exit;
end;
end;
end
else
Begin
Message(assem_e_syntax_error);
repeat
consume(actasmtoken)
until (actasmtoken = AS_SEPARATOR) or (actasmtoken = AS_COMMA);
end;
end;
Function BuildRefExpression: longint; Function BuildRefExpression: longint;
@ -2030,7 +2084,7 @@ var
{*********************************************************************} {*********************************************************************}
var tempstr: string; var tempstr: string;
expr: string; expr: string;
l : longint; l,k : longint;
errorflag : boolean; errorflag : boolean;
Begin Begin
errorflag := FALSE; errorflag := FALSE;
@ -2106,14 +2160,24 @@ var
end; end;
AS_ID: AS_ID:
Begin Begin
if NOT SearchIConstant(actasmpattern,l) then tempstr:=actasmpattern;
Begin consume(AS_ID);
Message1(assem_e_invalid_const_symbol,actasmpattern); if actasmtoken=AS_DOT then
l := 0; begin
end; GetRecordOffsetSize(tempstr,l,k);
str(l, tempstr); str(l, tempstr);
expr := expr + tempstr; expr := expr + tempstr;
Consume(AS_ID); end
else
begin
if SearchIConstant(actasmpattern,l) then
begin
str(l, tempstr);
expr := expr + tempstr;
end
else
Message1(assem_e_invalid_const_symbol,actasmpattern);
end;
end; end;
AS_INTNUM: Begin AS_INTNUM: Begin
expr := expr + actasmpattern; expr := expr + actasmpattern;
@ -2174,6 +2238,7 @@ var
var var
firstpass: boolean; firstpass: boolean;
offset: longint; offset: longint;
tsize,toffset : longint;
basetypename : string; basetypename : string;
Begin Begin
basetypename := ''; basetypename := '';
@ -2191,12 +2256,13 @@ var
{ // var_name.typefield.typefield // } { // var_name.typefield.typefield // }
if (varname <> '') then if (varname <> '') then
Begin Begin
if not GetVarOffset(instr,varname,actasmpattern,offset,operandnum) then if GetVarOffsetSize(varname,actasmpattern,toffset,tsize) then
Begin Begin
Message1(assem_e_unknown_id,actasmpattern); Inc(instr.operands[operandnum].ref.offset,tOffset);
SetOperandSize(instr,operandnum,tsize);
end end
else else
Inc(instr.operands[operandnum].ref.offset,Offset); Message1(assem_e_unknown_id,actasmpattern);
end end
else else
{ [ref].var_name.typefield.typefield ... } { [ref].var_name.typefield.typefield ... }
@ -2224,12 +2290,13 @@ var
{ [ref].typefield.typefield ... } { [ref].typefield.typefield ... }
{ basetpyename is already set up... now look for fields. } { basetpyename is already set up... now look for fields. }
Begin Begin
if not GetTypeOffset(instr,basetypename,actasmpattern,Offset,operandnum) then if GetTypeOffsetSize(basetypename,actasmpattern,tOffset,Tsize) then
Begin Begin
Message1(assem_e_unknown_id,actasmpattern); Inc(instr.operands[operandnum].ref.offset,tOffset);
SetOperandSize(instr,operandnum,Tsize);
end end
else else
Inc(instr.operands[operandnum].ref.offset,Offset); Message1(assem_e_unknown_id,actasmpattern);
end; end;
Consume(AS_ID); Consume(AS_ID);
{ Take care of index register on this variable } { Take care of index register on this variable }
@ -2287,7 +2354,7 @@ var
{*********************************************************************} {*********************************************************************}
var expr: string; var expr: string;
tempstr: string; tempstr: string;
l : longint; l,k : longint;
errorflag: boolean; errorflag: boolean;
Begin Begin
errorflag := FALSE; errorflag := FALSE;
@ -2350,14 +2417,24 @@ var
expr := expr + '|'; expr := expr + '|';
end; end;
AS_ID: Begin AS_ID: Begin
if NOT SearchIConstant(actasmpattern,l) then tempstr:=actasmpattern;
Begin consume(AS_ID);
Message1(assem_e_invalid_const_symbol,actasmpattern); if actasmtoken=AS_DOT then
l := 0; begin
end; GetRecordOffsetSize(tempstr,l,k);
str(l, tempstr); str(l, tempstr);
expr := expr + tempstr; expr := expr + tempstr;
Consume(AS_ID); end
else
begin
if SearchIConstant(actasmpattern,l) then
begin
str(l, tempstr);
expr := expr + tempstr;
end
else
Message1(assem_e_invalid_const_symbol,actasmpattern);
end;
end; end;
AS_INTNUM: Begin AS_INTNUM: Begin
expr := expr + actasmpattern; expr := expr + actasmpattern;
@ -3395,7 +3472,13 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.9 1998-10-13 16:50:17 pierre Revision 1.10 1998-11-05 23:48:27 peter
* recordtype.field support in constant expressions
* fixed imul for oa_imm8 which was not allowed
* fixed reading of local typed constants
* fixed comment reading which is not any longer a separator
Revision 1.9 1998/10/13 16:50:17 pierre
* undid some changes of Peter that made the compiler wrong * undid some changes of Peter that made the compiler wrong
for m68k (I had to reinsert some ifdefs) for m68k (I had to reinsert some ifdefs)
* removed several memory leaks under m68k * removed several memory leaks under m68k

19
compiler/scanner.pas
View File

@ -1479,8 +1479,7 @@ exit_label:
case c of case c of
'{' : begin '{' : begin
skipcomment; skipcomment;
lastasmgetchar:=c; asmgetchar:=c;
asmgetchar:=';';
exit; exit;
end; end;
'/' : begin '/' : begin
@ -1488,11 +1487,13 @@ exit_label:
if c='/' then if c='/' then
begin begin
skipdelphicomment; skipdelphicomment;
asmgetchar:=';'; asmgetchar:=c;
end end
else else
begin
asmgetchar:='/'; asmgetchar:='/';
lastasmgetchar:=c; lastasmgetchar:=c;
end;
exit; exit;
end; end;
'(' : begin '(' : begin
@ -1500,11 +1501,13 @@ exit_label:
if c='*' then if c='*' then
begin begin
skipoldtpcomment; skipoldtpcomment;
asmgetchar:=';'; asmgetchar:=c;
end end
else else
begin
asmgetchar:='('; asmgetchar:='(';
lastasmgetchar:=c; lastasmgetchar:=c;
end;
exit; exit;
end; end;
else else
@ -1519,7 +1522,13 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.65 1998-11-03 11:35:02 peter Revision 1.66 1998-11-05 23:48:29 peter
* recordtype.field support in constant expressions
* fixed imul for oa_imm8 which was not allowed
* fixed reading of local typed constants
* fixed comment reading which is not any longer a separator
Revision 1.65 1998/11/03 11:35:02 peter
* don't check for endif if error * don't check for endif if error
Revision 1.64 1998/10/21 20:16:05 peter Revision 1.64 1998/10/21 20:16:05 peter