mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-17 03:39:28 +02:00
* 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
This commit is contained in:
peter
parent
dedaf4db95
commit
d84489d9b7
@ -268,10 +268,9 @@ Type
|
||||
{ Symbol helper routines }
|
||||
{---------------------------------------------------------------------}
|
||||
|
||||
Function GetTypeOffset(var Instr: TInstruction; const base: string; const field: string;
|
||||
Var Offset: longint; operandnum: byte):boolean;
|
||||
Function GetVarOffset(var Instr: TInstruction;const base: string; const field: string;
|
||||
Var Offset: longint; operandnum: byte):boolean;
|
||||
Procedure SetOperandSize(var instr:TInstruction;operandnum,size:longint);
|
||||
Function GetVarOffsetSize(const base,field:string;Var Offset: longint;var Size:longint):boolean;
|
||||
Function GetTypeOffsetSize(const base,field: string;Var Offset: longint;var Size:longint):boolean;
|
||||
Function SearchIConstant(const s:string; var l:longint): boolean;
|
||||
Function SearchLabel(const s: string; var hl: plabel): boolean;
|
||||
Function CreateVarInstr(var Instr: TInstruction; const hs:string;
|
||||
@ -1000,13 +999,17 @@ end;
|
||||
getsym(s,false);
|
||||
if srsym <> nil then
|
||||
Begin
|
||||
if (srsym^.typ=constsym) and
|
||||
(pconstsym(srsym)^.consttype in [constord,constint,constchar,constbool]) then
|
||||
Begin
|
||||
l:=pconstsym(srsym)^.value;
|
||||
SearchIConstant := TRUE;
|
||||
exit;
|
||||
end;
|
||||
case srsym^.typ of
|
||||
constsym :
|
||||
begin
|
||||
if (pconstsym(srsym)^.consttype in [constord,constint,constchar,constbool]) then
|
||||
Begin
|
||||
l:=pconstsym(srsym)^.value;
|
||||
SearchIConstant := TRUE;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -1043,18 +1046,39 @@ end;
|
||||
{$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;
|
||||
{ search and returns the offset of records/objects of the base }
|
||||
|
||||
Function GetVarOffsetSize(const base,field:string;Var Offset: longint;var Size:longint):boolean;
|
||||
{ search and returns the offset and size of records/objects of the base }
|
||||
{ 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. }
|
||||
var
|
||||
sym:psym;
|
||||
p: psym;
|
||||
Begin
|
||||
GetVarOffset := FALSE;
|
||||
GetVarOffsetSize := FALSE;
|
||||
Offset := 0;
|
||||
{ local list }
|
||||
if assigned(aktprocsym) then
|
||||
@ -1072,25 +1096,8 @@ end;
|
||||
if assigned(pvarsym(p)) then
|
||||
Begin
|
||||
Offset := pvarsym(p)^.address;
|
||||
{ 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 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;
|
||||
Size:=PVarsym(p)^.getsize;
|
||||
GetVarOffsetSize := TRUE;
|
||||
Exit;
|
||||
end;
|
||||
end
|
||||
@ -1103,26 +1110,9 @@ end;
|
||||
if assigned(pvarsym(p)) then
|
||||
Begin
|
||||
Offset := pvarsym(p)^.address;
|
||||
{ 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 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;
|
||||
Size:=PVarsym(p)^.getsize;
|
||||
GetVarOffsetSize := TRUE;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -1131,7 +1121,7 @@ end;
|
||||
begin
|
||||
{ field of local record parameter to routine. }
|
||||
if assigned(aktprocsym^.definition^.parast) then
|
||||
sym:=aktprocsym^.definition^.parast^.search(base)
|
||||
sym:=aktprocsym^.definition^.parast^.search(base)
|
||||
else
|
||||
sym:=nil;
|
||||
if assigned(sym) then
|
||||
@ -1143,25 +1133,8 @@ end;
|
||||
if assigned(p) then
|
||||
Begin
|
||||
Offset := pvarsym(p)^.address;
|
||||
GetVarOffset := TRUE;
|
||||
{ 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 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;
|
||||
Size:=PVarsym(p)^.getsize;
|
||||
GetVarOffsetSize := TRUE;
|
||||
Exit;
|
||||
end;
|
||||
end { endif }
|
||||
@ -1174,26 +1147,9 @@ end;
|
||||
if assigned(pvarsym(p)) then
|
||||
Begin
|
||||
Offset := pvarsym(p)^.address;
|
||||
{ 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 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;
|
||||
Size:=PVarsym(p)^.getsize;
|
||||
GetVarOffsetSize := TRUE;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -1213,25 +1169,8 @@ end;
|
||||
if assigned(p) then
|
||||
Begin
|
||||
Offset := pvarsym(p)^.address;
|
||||
GetVarOffset := TRUE;
|
||||
{ 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 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;
|
||||
Size:=PVarsym(p)^.getsize;
|
||||
GetVarOffsetSize := TRUE;
|
||||
Exit;
|
||||
end;
|
||||
end
|
||||
@ -1244,25 +1183,8 @@ end;
|
||||
if assigned(p) then
|
||||
Begin
|
||||
Offset := pvarsym(p)^.address;
|
||||
GetVarOffset := TRUE;
|
||||
{ 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 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;
|
||||
Size:=PVarsym(p)^.getsize;
|
||||
GetVarOffsetSize := TRUE;
|
||||
Exit;
|
||||
end;
|
||||
end
|
||||
@ -1275,26 +1197,9 @@ end;
|
||||
if assigned(pvarsym(p)) then
|
||||
Begin
|
||||
Offset := pvarsym(p)^.address;
|
||||
{ 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 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;
|
||||
Size:=PVarsym(p)^.getsize;
|
||||
GetVarOffsetSize := TRUE;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
@ -1303,8 +1208,7 @@ end;
|
||||
|
||||
|
||||
|
||||
Function GetTypeOffset(var instr: TInstruction; const base: string; const field: string;
|
||||
Var Offset: longint; operandnum: byte):boolean;
|
||||
Function GetTypeOffsetSize(const base,field: string;Var Offset: longint;var Size:longint):boolean;
|
||||
{ search and returns the offset of records/objects of the base }
|
||||
{ with field name setup in field. }
|
||||
{ returns 0 if not found. }
|
||||
@ -1314,7 +1218,7 @@ end;
|
||||
p: psym;
|
||||
Begin
|
||||
Offset := 0;
|
||||
GetTypeOffset := FALSE;
|
||||
GetTypeOffsetSize := FALSE;
|
||||
{ local list }
|
||||
if assigned(aktprocsym) then
|
||||
begin
|
||||
@ -1331,25 +1235,8 @@ end;
|
||||
if assigned(p) then
|
||||
Begin
|
||||
Offset := pvarsym(p)^.address;
|
||||
{ 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 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;
|
||||
Size:=PVarsym(p)^.getsize;
|
||||
GetTypeOffsetSize := TRUE;
|
||||
Exit;
|
||||
end;
|
||||
end;
|
||||
@ -1370,25 +1257,7 @@ end;
|
||||
if assigned(p) then
|
||||
Begin
|
||||
Offset := pvarsym(p)^.address;
|
||||
{ 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 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;
|
||||
GetTypeOffsetSize := TRUE;
|
||||
Exit;
|
||||
end;
|
||||
end; { endif }
|
||||
@ -1408,25 +1277,8 @@ end;
|
||||
if assigned(p) then
|
||||
Begin
|
||||
Offset := pvarsym(p)^.address;
|
||||
{ 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 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;
|
||||
Size:=PVarsym(p)^.getsize;
|
||||
GetTypeOffsetSize := TRUE;
|
||||
Exit;
|
||||
end
|
||||
end
|
||||
@ -1440,25 +1292,8 @@ end;
|
||||
if assigned(p) then
|
||||
Begin
|
||||
Offset := pvarsym(p)^.address;
|
||||
{ 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 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;
|
||||
Size:=PVarsym(p)^.getsize;
|
||||
GetTypeOffsetSize := TRUE;
|
||||
Exit;
|
||||
end
|
||||
end;
|
||||
@ -1487,7 +1322,6 @@ end;
|
||||
if assigned(sym) then
|
||||
begin
|
||||
case sym^.typ of
|
||||
typedconstsym,
|
||||
varsym : begin
|
||||
{ we always assume in asm statements that }
|
||||
{ that the variable is valid. }
|
||||
@ -1525,6 +1359,31 @@ end;
|
||||
CreateVarInstr := TRUE;
|
||||
Exit;
|
||||
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
|
||||
if pconstsym(sym)^.consttype in [constint,constchar,constbool] then
|
||||
begin
|
||||
@ -1534,6 +1393,15 @@ end;
|
||||
Exit;
|
||||
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
|
||||
{ free the memory before changing the symbol name. }
|
||||
if assigned(instr.operands[operandnum].ref.symbol) then
|
||||
@ -1653,6 +1521,15 @@ end;
|
||||
Exit;
|
||||
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
|
||||
if assigned(pprocsym(sym)^.definition^.nextoverloaded) then
|
||||
Message(assem_w_calling_overload_func);
|
||||
@ -1902,7 +1779,13 @@ end;
|
||||
end.
|
||||
{
|
||||
$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
|
||||
+ constants are now handled also when starting an expression
|
||||
+ call *pointer is now allowed
|
||||
|
||||
@ -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;
|
||||
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 : $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 : 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),
|
||||
@ -1724,7 +1725,13 @@ unit i386;
|
||||
end.
|
||||
{
|
||||
$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
|
||||
+ constants are now handled also when starting an expression
|
||||
+ call *pointer is now allowed
|
||||
|
||||
@ -398,6 +398,7 @@ type tmsgconst=(
|
||||
assem_f_too_many_asm_files,
|
||||
assem_f_assembler_output_not_supported,
|
||||
assem_e_unsupported_symbol_type,
|
||||
assem_e_cannot_index_relative_var,
|
||||
exec_w_source_os_redefined,
|
||||
exec_i_assembling_pipe,
|
||||
exec_d_cant_create_asmfile,
|
||||
|
||||
@ -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+
|
||||
'D_Source 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_Selected assembler',' output not supported'#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+
|
||||
'I_Assembling (pipe) $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+
|
||||
'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'+
|
||||
'ing'#000+
|
||||
'I_Assembling $1'#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_Library $','1 not found, Linking may fail !'#000+
|
||||
'W_Library $1 not found, Linking may fail !'#000+
|
||||
'W_Error while linking'#000+
|
||||
'W_Can'#039't call the linker, switching to external linking'#000+
|
||||
'I_Linking $1'#000+
|
||||
'W_binder not found, switching to external binding'#000+
|
||||
'W_ar not found, switching to external ar'#000+
|
||||
'E_Dynamic Libraries not sup','ported'#000+
|
||||
'W_ar not fou','nd, switching to external ar'#000+
|
||||
'E_Dynamic Libraries not supported'#000+
|
||||
'I_Closing script $1'#000+
|
||||
'F_Can'#039't post process executable $1'#000+
|
||||
'F_Can'#039't open executable $1'#000+
|
||||
'X_Size of Code: $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 com','mited: $1 bytes'#000+
|
||||
'X_Stack space commited: $1 bytes'#000+
|
||||
'T_Unitsearch: $1'#000+
|
||||
'T_PPU Loading $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 File too short'#000+
|
||||
'U_PPU Invalid Header (no PPU at the begin)'#000+
|
||||
'U_PPU Invalid Version $1'#000+
|
||||
'U_PPU is compiled for an other processor'#000,+
|
||||
'U_PPU Inva','lid Version $1'#000+
|
||||
'U_PPU is compiled for an other processor'#000+
|
||||
'U_PPU is compiled for an other target'#000+
|
||||
'U_PPU Source: $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_unexpected end of PPU-File'#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+
|
||||
'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+
|
||||
'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_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, shared lib is 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_Parsing interface of',' $1'#000+
|
||||
'U_Recomp','iling unit, obj is older than asm'#000+
|
||||
'U_Parsing interface of $1'#000+
|
||||
'U_Parsing implementation of $1'#000+
|
||||
'U_Second load for unit $1'#000+
|
||||
'U_PPU Check file $1 time $2'#000+
|
||||
'$1 [options] <inputfile> [options]'#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+
|
||||
'F','_No source file name in command line'#000+
|
||||
'F_No source file name in command line'#000+
|
||||
'E_Illegal parameter: $1'#000+
|
||||
'H_-? writes help pages'#000+
|
||||
'F_Too many config files nested'#000+
|
||||
'F_Unable to open file $1'#000+
|
||||
'N_Reading further options from $1'#000+
|
||||
'W_Target is already set to: $1'#000+
|
||||
'W_Shared libs not supported on DOS ','platform, reverting to static'#000+
|
||||
'W_Target i','s already set to: $1'#000+
|
||||
'W_Shared libs not supported on DOS platform, reverting to static'#000+
|
||||
'F_too many IF(N)DEFs'#000+
|
||||
'F_too many ENDIFs'#000+
|
||||
'F_open conditional at the end of the file'#000+
|
||||
'W_Debug information generation is not supported by this executable'#000+
|
||||
'H_Try recompiling with -dGDB'#000+
|
||||
'W_You are using the obsolete swit','ch $1'#000+
|
||||
'H_Try ','recompiling with -dGDB'#000+
|
||||
'W_You are using the obsolete switch $1'#000+
|
||||
'Free Pascal Compiler version $FPCVER [$FPCDATE] for $FPCTARGET'#000+
|
||||
'Copyright (c) 1993-98 by Florian Klaempfl'#000+
|
||||
'Free Pascal Compiler version $FPCVER'#000+
|
||||
#000+
|
||||
'Compiler Date : $FPCDATE'#000+
|
||||
'Compiler Target: $FPCTARGET'#000+
|
||||
'Compiler ','Target: $FPCTARGET'#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+
|
||||
#000+
|
||||
'Report bugs,suggestions etc to:'#000+
|
||||
' fpc-devel@mail.tolna.hungary.net'#000+
|
||||
'**0*_put + after a boolean switch option to enable it, - to disable it'+
|
||||
#000+
|
||||
'**1a_the compiler doesn'#039't del','ete the generated assembler file'#000+
|
||||
'**0*_put + after a boolean switch option to ','enable it, - to disable '+
|
||||
'it'#000+
|
||||
'**1a_the compiler doesn'#039't delete the generated assembler file'#000+
|
||||
'**2al_list sourcecode lines in assembler file'#000+
|
||||
'*t1b_use EMS'#000+
|
||||
'**1B_build all modules'#000+
|
||||
'**1C_code generation options'#000+
|
||||
'3*2CD_create dynamic library'#000+
|
||||
'**2Ch<n>_<n> bytes heap (between 1023 and 67107840)'#000+
|
||||
'**2Ci_IO-checki','ng'#000+
|
||||
'**2Ch<n>_<n','> bytes heap (between 1023 and 67107840)'#000+
|
||||
'**2Ci_IO-checking'#000+
|
||||
'**2Cn_omit linking stage'#000+
|
||||
'**2Co_check overflow of integer operations'#000+
|
||||
'**2Cr_range checking'#000+
|
||||
'**2Cs<n>_set stack size to <n>'#000+
|
||||
'**2Ct_stack checking'#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+
|
||||
'*O1D_generate ','a DEF file'#000+
|
||||
'*O1D_generate a DEF file'#000+
|
||||
'*O2Dd<x>_set description to <x>'#000+
|
||||
'*O2Dw_PM application'#000+
|
||||
'**1e<x>_set path to executable'#000+
|
||||
'**1E_same as -Cn'#000+
|
||||
'**1F_set file names and paths'#000+
|
||||
'**2FD<x>_sets the directory where to search for compiler utilities'#000+
|
||||
'**2Fe<x>_redirect error output ','to <x>'#000+
|
||||
'**2FD<x>_sets the directory where to searc','h for compiler utilities'#000+
|
||||
'**2Fe<x>_redirect error output to <x>'#000+
|
||||
'**2FE<x>_set exe/unit output path to <x>'#000+
|
||||
'*L2Fg<x>_same as -Fl'#000+
|
||||
'**2Fi<x>_adds <x> to include path'#000+
|
||||
'**2Fl<x>_adds <x> to library path'#000+
|
||||
'*L2FL<x>_uses <x> as dynamic linker'#000+
|
||||
'**2Fo<x>_adds <x> to object path'#000+
|
||||
'**2Fr<x>_load error message file <','x>'#000+
|
||||
'**2Fo<x>_ad','ds <x> to object path'#000+
|
||||
'**2Fr<x>_load error message file <x>'#000+
|
||||
'**2Fu<x>_adds <x> to unit path'#000+
|
||||
'**2FU<x>_set unit output path to <x>, overrides -FE'#000+
|
||||
'*g1g_generate debugger information'#000+
|
||||
'*g2gg_use gsym'#000+
|
||||
'*g2gd_use dbx'#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+
|
||||
'**1l_writ','e logo'#000+
|
||||
'**1l_write logo'#000+
|
||||
'**1n_don'#039't read the default config file'#000+
|
||||
'**1o<x>_change the name of the executable produced to <x>'#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+
|
||||
'**2S2_switch som','e Delphi 2 extensions on'#000+
|
||||
'**2S2_switch some Delphi 2 extensions on'#000+
|
||||
'**2Sc_supports operators like C (*=,+=,/= and -=)'#000+
|
||||
'**2Sd_tries to be Delphi compatible'#000+
|
||||
'**2Se_compiler stops after the first error'#000+
|
||||
'**2Sg_allow LABEL and GOTO'#000+
|
||||
'**2Si_support C++ stlyed INLINE'#000+
|
||||
'**2Sm_support macros like C',' (global)'#000+
|
||||
'**2','Si_support C++ stlyed INLINE'#000+
|
||||
'**2Sm_support macros like C (global)'#000+
|
||||
'**2So_tries to be TP/BP 7.0 compatible'#000+
|
||||
'**2Sp_tries to be gpc compatible'#000+
|
||||
'**2Ss_constructor name must be init (destructor must be done)'#000+
|
||||
'**2St_allow static keyword in objects'#000+
|
||||
'**1s_don'#039't call assembler and linker (only with -a)'#000+
|
||||
'**1u<x','>_undefines the symbol <x>'#000+
|
||||
'**','1s_don'#039't call assembler and linker (only with -a)'#000+
|
||||
'**1u<x>_undefines the symbol <x>'#000+
|
||||
'**1U_unit options'#000+
|
||||
'**2Un_don'#039't check the unit name'#000+
|
||||
'**2Up<x>_same as -Fu<x>'#000+
|
||||
'**2Us_compile a system unit'#000+
|
||||
'**1v<x>_Be verbose. <x> is a combination of the following letters :'#000+
|
||||
'**2*_e : Show errors (default) d : Sh','ow debug info'#000+
|
||||
'**1v<x>_Be verbose. <x> is a combination of the followi','ng letters :'#000+
|
||||
'**2*_e : Show errors (default) d : Show debug info'#000+
|
||||
'**2*_w : Show warnings u : Show unit info'#000+
|
||||
'**2*_n : Show notes t : Show tried/used files'#000+
|
||||
'**2*_h : Show hints m : Show defined macros'#000+
|
||||
'**2*_i : Show general info p : Show ','compiled procedures'#000+
|
||||
'**2*_h : Show hints m : Show defin','ed macros'#000+
|
||||
'**2*_i : Show general info p : Show compiled procedures'#000+
|
||||
'**2*_l : Show linenumbers c : Show conditionals'#000+
|
||||
'**2*_a : Show everything 0 : Show nothing (except errors)'#000+
|
||||
'**2*_b : Show all procedure r : Rhide/GCC compatibility mode'#000+
|
||||
'**2*_ declarations',' if an error x : Executable info (Win32 only'+
|
||||
')'#000+
|
||||
'**2*_b : Show all procedure ',' r : Rhide/GCC compatibility mod'+
|
||||
'e'#000+
|
||||
'**2*_ declarations if an error x : Executable info (Win32 only)'#000+
|
||||
'**2*_ occurs'#000+
|
||||
'**1X_executable options'#000+
|
||||
'*L2Xc_link with the c library'#000+
|
||||
'**2XD_link with dynamic libraries (defines FPC_LINK_DYNAMIC)'#000+
|
||||
'**2Xs_strip all symbols from executable'#000+
|
||||
'**2XS_link with stat','ic libraries (defines FPC_LINK_STATIC)'#000+
|
||||
'**2X','s_strip all symbols from executable'#000+
|
||||
'**2XS_link with static libraries (defines FPC_LINK_STATIC)'#000+
|
||||
'**0*_Processor specific options:'#000+
|
||||
'3*1A<x>_output format'#000+
|
||||
'3*2Ao_coff file using GNU AS'#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*2Amasm_','obj using Masm (Mircosoft)'#000+
|
||||
'3*2Amasm_obj using Masm (Mircosoft)'#000+
|
||||
'3*2Atasm_obj using Tasm (Borland)'#000+
|
||||
'3*1R<x>_assembler reading style'#000+
|
||||
'3*2Ratt_read AT&T style assembler'#000+
|
||||
'3*2Rintel_read Intel style assembler'#000+
|
||||
'3*2Rdirect_copy assembler text directly to assembler file'#000+
|
||||
'3*1O<x>_optimizati','ons'#000+
|
||||
'3*2Rdirect_copy asse','mbler text directly to assembler file'#000+
|
||||
'3*1O<x>_optimizations'#000+
|
||||
'3*2Og_generate smaller code'#000+
|
||||
'3*2OG_generate faster code (default)'#000+
|
||||
'3*2Or_keep certain variables in registers (still BUGGY!!!)'#000+
|
||||
'3*2Ou_enable uncertain optimizations (see docs)'#000+
|
||||
'3*2O1_level 1 optimizations (quick optimizations)'#000+
|
||||
'3*2O2_level 2 ','optimizations (-O1 + slower optimizations)'#000+
|
||||
'3*2O1_le','vel 1 optimizations (quick optimizations)'#000+
|
||||
'3*2O2_level 2 optimizations (-O1 + slower optimizations)'#000+
|
||||
'3*2O3_level 3 optimizations (same as -O2u)'#000+
|
||||
'3*2Op_target processor'#000+
|
||||
'3*3Op1_set target processor to 386/486'#000+
|
||||
'3*3Op2_set target processor to Pentium/PentiumMMX (tm)'#000+
|
||||
'3*3Op3_set target processor to PPro/P','II/c6x86/K6 (tm)'#000+
|
||||
'3*3Op2_set target processor to Penti','um/PentiumMMX (tm)'#000+
|
||||
'3*3Op3_set target processor to PPro/PII/c6x86/K6 (tm)'#000+
|
||||
'3*1T<x>_Target operating system'#000+
|
||||
'3*2TGO32V1_version 1 of DJ Delorie DOS extender'#000+
|
||||
'3*2TGO32V2_version 2 of DJ Delorie DOS extender'#000+
|
||||
'3*2TLINUX_Linux'#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*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*2Amit_MIT Syntax (old GAS)'#000+
|
||||
'6*2Amot_Standard Motorola assembler'#000+
|
||||
'6*1O_optimizations'#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*2Ox_optimize m','aximum (still BUGGY!!!)'#000+
|
||||
'6*2Ox_optimize maximum (still BUGGY!!!)'#000+
|
||||
'6*2O2_set target processor to a MC68020+'#000+
|
||||
'6*1R<x>_assembler reading style'#000+
|
||||
'6*2RMOT_read motorola style assembler'#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*2TMACOS_Macintosh m','68k'#000+
|
||||
'6*2TMACOS_Macintosh m68k'#000+
|
||||
'6*2TLINUX_Linux-68k'#000+
|
||||
'**1*_'#000+
|
||||
'**1?_shows this help'#000+
|
||||
|
||||
@ -1575,7 +1575,6 @@ const
|
||||
end;
|
||||
{ ------------------------------------------------------------------- }
|
||||
|
||||
|
||||
{ copy them to local variables }
|
||||
{ for faster access }
|
||||
optyp1:=operands[1].opinfo;
|
||||
@ -2419,6 +2418,62 @@ const
|
||||
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;
|
||||
@ -2437,7 +2492,7 @@ const
|
||||
{*********************************************************************}
|
||||
var expr: string;
|
||||
tempstr: string;
|
||||
l : longint;
|
||||
l,k : longint;
|
||||
errorflag: boolean;
|
||||
Begin
|
||||
errorflag := FALSE;
|
||||
@ -2498,15 +2553,26 @@ const
|
||||
expr := expr + '|';
|
||||
end;
|
||||
AS_ID: Begin
|
||||
if NOT SearchIConstant(actasmpattern,l) then
|
||||
Begin
|
||||
Message1(assem_e_invalid_const_symbol,actasmpattern);
|
||||
l := 0;
|
||||
tempstr:=actasmpattern;
|
||||
previous_was_id:=TRUE;
|
||||
consume(AS_ID);
|
||||
if actasmtoken=AS_DOT then
|
||||
begin
|
||||
GetRecordOffsetSize(tempstr,l,k);
|
||||
str(l, tempstr);
|
||||
expr := expr + tempstr;
|
||||
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;
|
||||
str(l, tempstr);
|
||||
expr := expr + tempstr;
|
||||
Consume(AS_ID);
|
||||
end;
|
||||
AS_INTNUM: Begin
|
||||
expr := expr + actasmpattern;
|
||||
Consume(AS_INTNUM);
|
||||
@ -2739,7 +2805,7 @@ const
|
||||
{*********************************************************************}
|
||||
var tempstr: string;
|
||||
expr: string;
|
||||
l : longint;
|
||||
l,k : longint;
|
||||
errorflag : boolean;
|
||||
Begin
|
||||
errorflag := FALSE;
|
||||
@ -2806,14 +2872,24 @@ const
|
||||
end;
|
||||
AS_ID:
|
||||
Begin
|
||||
if NOT SearchIConstant(actasmpattern,l) then
|
||||
Begin
|
||||
Message1(assem_e_invalid_const_symbol,actasmpattern);
|
||||
l := 0;
|
||||
end;
|
||||
str(l, tempstr);
|
||||
expr := expr + tempstr;
|
||||
Consume(AS_ID);
|
||||
tempstr:=actasmpattern;
|
||||
consume(AS_ID);
|
||||
if actasmtoken=AS_DOT then
|
||||
begin
|
||||
GetRecordOffsetSize(tempstr,l,k);
|
||||
str(l, tempstr);
|
||||
expr := expr + tempstr;
|
||||
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;
|
||||
AS_INTNUM: Begin
|
||||
expr := expr + actasmpattern;
|
||||
@ -2879,8 +2955,11 @@ const
|
||||
Case actasmtoken of
|
||||
{ // (reg ... // }
|
||||
AS_REGISTER: Begin
|
||||
instr.operands[operandnum].ref.base :=
|
||||
findregister(actasmpattern);
|
||||
{ Check if there is already a base (mostly ebp,esp) than this is
|
||||
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);
|
||||
{ can either be a register or a right parenthesis }
|
||||
{ // (reg) // }
|
||||
@ -3046,75 +3125,6 @@ const
|
||||
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);
|
||||
{*********************************************************************}
|
||||
{ EXIT CONDITION: On exit the routine should point to either the }
|
||||
@ -3125,6 +3135,8 @@ const
|
||||
expr: string;
|
||||
lab: Pasmlabel;
|
||||
hl: plabel;
|
||||
tsize,
|
||||
toffset : longint;
|
||||
Begin
|
||||
tempstr := '';
|
||||
expr := '';
|
||||
@ -3271,7 +3283,7 @@ const
|
||||
Message1(assem_e_unknown_id,actasmpattern);
|
||||
end;
|
||||
{ constant expression? }
|
||||
if instr.operands[operandnum].operandtype=OPR_CONSTANT then
|
||||
if (instr.operands[operandnum].operandtype=OPR_CONSTANT) then
|
||||
instr.operands[operandnum].val := BuildExpression
|
||||
else
|
||||
begin
|
||||
@ -3284,7 +3296,9 @@ const
|
||||
BuildReference(instr);
|
||||
end;
|
||||
AS_DOT : Begin
|
||||
BuildRecordOffset(expr,instr);
|
||||
GetRecordOffsetSize(expr,toffset,tsize);
|
||||
inc(instr.operands[operandnum].ref.offset,toffset);
|
||||
SetOperandSize(instr,operandnum,tsize);
|
||||
end;
|
||||
AS_SEPARATOR,AS_COMMA: ;
|
||||
else
|
||||
@ -3875,7 +3889,13 @@ end.
|
||||
|
||||
{
|
||||
$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
|
||||
|
||||
Revision 1.16 1998/10/28 00:08:48 peter
|
||||
|
||||
@ -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;
|
||||
@ -2030,7 +2084,7 @@ var
|
||||
{*********************************************************************}
|
||||
var tempstr: string;
|
||||
expr: string;
|
||||
l : longint;
|
||||
l,k : longint;
|
||||
errorflag : boolean;
|
||||
Begin
|
||||
errorflag := FALSE;
|
||||
@ -2106,14 +2160,24 @@ var
|
||||
end;
|
||||
AS_ID:
|
||||
Begin
|
||||
if NOT SearchIConstant(actasmpattern,l) then
|
||||
Begin
|
||||
Message1(assem_e_invalid_const_symbol,actasmpattern);
|
||||
l := 0;
|
||||
end;
|
||||
str(l, tempstr);
|
||||
expr := expr + tempstr;
|
||||
Consume(AS_ID);
|
||||
tempstr:=actasmpattern;
|
||||
consume(AS_ID);
|
||||
if actasmtoken=AS_DOT then
|
||||
begin
|
||||
GetRecordOffsetSize(tempstr,l,k);
|
||||
str(l, tempstr);
|
||||
expr := expr + tempstr;
|
||||
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;
|
||||
AS_INTNUM: Begin
|
||||
expr := expr + actasmpattern;
|
||||
@ -2174,6 +2238,7 @@ var
|
||||
var
|
||||
firstpass: boolean;
|
||||
offset: longint;
|
||||
tsize,toffset : longint;
|
||||
basetypename : string;
|
||||
Begin
|
||||
basetypename := '';
|
||||
@ -2191,12 +2256,13 @@ var
|
||||
{ // var_name.typefield.typefield // }
|
||||
if (varname <> '') then
|
||||
Begin
|
||||
if not GetVarOffset(instr,varname,actasmpattern,offset,operandnum) then
|
||||
if GetVarOffsetSize(varname,actasmpattern,toffset,tsize) then
|
||||
Begin
|
||||
Message1(assem_e_unknown_id,actasmpattern);
|
||||
Inc(instr.operands[operandnum].ref.offset,tOffset);
|
||||
SetOperandSize(instr,operandnum,tsize);
|
||||
end
|
||||
else
|
||||
Inc(instr.operands[operandnum].ref.offset,Offset);
|
||||
Message1(assem_e_unknown_id,actasmpattern);
|
||||
end
|
||||
else
|
||||
{ [ref].var_name.typefield.typefield ... }
|
||||
@ -2224,12 +2290,13 @@ var
|
||||
{ [ref].typefield.typefield ... }
|
||||
{ basetpyename is already set up... now look for fields. }
|
||||
Begin
|
||||
if not GetTypeOffset(instr,basetypename,actasmpattern,Offset,operandnum) then
|
||||
if GetTypeOffsetSize(basetypename,actasmpattern,tOffset,Tsize) then
|
||||
Begin
|
||||
Message1(assem_e_unknown_id,actasmpattern);
|
||||
Inc(instr.operands[operandnum].ref.offset,tOffset);
|
||||
SetOperandSize(instr,operandnum,Tsize);
|
||||
end
|
||||
else
|
||||
Inc(instr.operands[operandnum].ref.offset,Offset);
|
||||
Message1(assem_e_unknown_id,actasmpattern);
|
||||
end;
|
||||
Consume(AS_ID);
|
||||
{ Take care of index register on this variable }
|
||||
@ -2287,7 +2354,7 @@ var
|
||||
{*********************************************************************}
|
||||
var expr: string;
|
||||
tempstr: string;
|
||||
l : longint;
|
||||
l,k : longint;
|
||||
errorflag: boolean;
|
||||
Begin
|
||||
errorflag := FALSE;
|
||||
@ -2350,14 +2417,24 @@ var
|
||||
expr := expr + '|';
|
||||
end;
|
||||
AS_ID: Begin
|
||||
if NOT SearchIConstant(actasmpattern,l) then
|
||||
Begin
|
||||
Message1(assem_e_invalid_const_symbol,actasmpattern);
|
||||
l := 0;
|
||||
end;
|
||||
str(l, tempstr);
|
||||
expr := expr + tempstr;
|
||||
Consume(AS_ID);
|
||||
tempstr:=actasmpattern;
|
||||
consume(AS_ID);
|
||||
if actasmtoken=AS_DOT then
|
||||
begin
|
||||
GetRecordOffsetSize(tempstr,l,k);
|
||||
str(l, tempstr);
|
||||
expr := expr + tempstr;
|
||||
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;
|
||||
AS_INTNUM: Begin
|
||||
expr := expr + actasmpattern;
|
||||
@ -3395,7 +3472,13 @@ begin
|
||||
end.
|
||||
{
|
||||
$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
|
||||
for m68k (I had to reinsert some ifdefs)
|
||||
* removed several memory leaks under m68k
|
||||
|
||||
@ -1479,8 +1479,7 @@ exit_label:
|
||||
case c of
|
||||
'{' : begin
|
||||
skipcomment;
|
||||
lastasmgetchar:=c;
|
||||
asmgetchar:=';';
|
||||
asmgetchar:=c;
|
||||
exit;
|
||||
end;
|
||||
'/' : begin
|
||||
@ -1488,11 +1487,13 @@ exit_label:
|
||||
if c='/' then
|
||||
begin
|
||||
skipdelphicomment;
|
||||
asmgetchar:=';';
|
||||
asmgetchar:=c;
|
||||
end
|
||||
else
|
||||
asmgetchar:='/';
|
||||
lastasmgetchar:=c;
|
||||
begin
|
||||
asmgetchar:='/';
|
||||
lastasmgetchar:=c;
|
||||
end;
|
||||
exit;
|
||||
end;
|
||||
'(' : begin
|
||||
@ -1500,11 +1501,13 @@ exit_label:
|
||||
if c='*' then
|
||||
begin
|
||||
skipoldtpcomment;
|
||||
asmgetchar:=';';
|
||||
asmgetchar:=c;
|
||||
end
|
||||
else
|
||||
asmgetchar:='(';
|
||||
lastasmgetchar:=c;
|
||||
begin
|
||||
asmgetchar:='(';
|
||||
lastasmgetchar:=c;
|
||||
end;
|
||||
exit;
|
||||
end;
|
||||
else
|
||||
@ -1519,7 +1522,13 @@ begin
|
||||
end.
|
||||
{
|
||||
$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
|
||||
|
||||
Revision 1.64 1998/10/21 20:16:05 peter
|
||||
|
||||
Loading…
Reference in New Issue
Block a user