* when handling absolute vars from within intel inline assembly, take the

absolute var size into account (not the type of the var it points to or no
  size at all, if it points to a fixed address)

git-svn-id: trunk@37525 -
This commit is contained in:
nickysn 2017-10-26 15:58:48 +00:00
parent eef6e65730
commit d318ab086a
4 changed files with 124 additions and 3 deletions

2
.gitattributes vendored
View File

@ -12109,6 +12109,8 @@ tests/test/cpu16/i8086/tasm16_32_1.pp svneol=native#text/pascal
tests/test/cpu16/i8086/tasm16_32_2.pp svneol=native#text/pascal tests/test/cpu16/i8086/tasm16_32_2.pp svneol=native#text/pascal
tests/test/cpu16/i8086/tasm16_32_3.pp svneol=native#text/pascal tests/test/cpu16/i8086/tasm16_32_3.pp svneol=native#text/pascal
tests/test/cpu16/i8086/tasm16_32_4.pp svneol=native#text/pascal tests/test/cpu16/i8086/tasm16_32_4.pp svneol=native#text/pascal
tests/test/cpu16/i8086/tasmabs1.pp svneol=native#text/pascal
tests/test/cpu16/i8086/tasmabs2.pp svneol=native#text/pascal
tests/test/cpu16/i8086/tasmseg1.pp svneol=native#text/pascal tests/test/cpu16/i8086/tasmseg1.pp svneol=native#text/pascal
tests/test/cpu16/i8086/tfarcal1.pp svneol=native#text/pascal tests/test/cpu16/i8086/tfarcal1.pp svneol=native#text/pascal
tests/test/cpu16/i8086/tfarcal2.pp svneol=native#text/pascal tests/test/cpu16/i8086/tfarcal2.pp svneol=native#text/pascal

View File

@ -806,6 +806,7 @@ var
srsymtable : TSymtable; srsymtable : TSymtable;
indexreg : tregister; indexreg : tregister;
plist : ppropaccesslistitem; plist : ppropaccesslistitem;
size_set_from_absolute : boolean = false;
Begin Begin
SetupVar:=false; SetupVar:=false;
asmsearchsym(s,sym,srsymtable); asmsearchsym(s,sym,srsymtable);
@ -820,7 +821,11 @@ Begin
plist:=tabsolutevarsym(sym).ref.firstsym; plist:=tabsolutevarsym(sym).ref.firstsym;
if assigned(plist) and if assigned(plist) and
(plist^.sltype=sl_load) then (plist^.sltype=sl_load) then
sym:=plist^.sym begin
setvarsize(tabstractvarsym(sym));
size_set_from_absolute:=true;
sym:=plist^.sym;
end
else else
begin begin
Message(asmr_e_unsupported_symbol_type); Message(asmr_e_unsupported_symbol_type);
@ -831,6 +836,9 @@ Begin
begin begin
initref; initref;
opr.ref.offset:=tabsolutevarsym(sym).addroffset; opr.ref.offset:=tabsolutevarsym(sym).addroffset;
setvarsize(tabstractvarsym(sym));
size_set_from_absolute:=true;
hasvar:=true;
Result:=true; Result:=true;
exit; exit;
end; end;
@ -850,7 +858,8 @@ Begin
setconst(tfieldvarsym(sym).fieldoffset div 8) setconst(tfieldvarsym(sym).fieldoffset div 8)
else else
Message(asmr_e_packed_element); Message(asmr_e_packed_element);
setvarsize(tabstractvarsym(sym)); if not size_set_from_absolute then
setvarsize(tabstractvarsym(sym));
hasvar:=true; hasvar:=true;
SetupVar:=true; SetupVar:=true;
end; end;
@ -905,7 +914,8 @@ Begin
SetSize(sizeof(pint),false); SetSize(sizeof(pint),false);
end; end;
end; end;
setvarsize(tabstractvarsym(sym)); if not size_set_from_absolute then
setvarsize(tabstractvarsym(sym));
hasvar:=true; hasvar:=true;
SetupVar:=true; SetupVar:=true;
Exit; Exit;

View File

@ -0,0 +1,49 @@
{ %cpu=i8086 }
{ this test is Turbo Pascal 7 compatible }
program tasmabs1;
{$IFDEF FPC}
{$ASMMODE INTEL}
{$ASMCPU 80386}
{$ENDIF}
var
barr: array [0..100] of byte;
l: longint absolute barr;
w: word absolute barr;
b: byte absolute barr;
begin
{$IFDEF FPC}
FillChar(barr, SizeOf(barr), $ff);
asm
mov l, 4
end;
if (barr[0] <> 4) or (barr[1] <> 0) or (barr[2] <> 0) or
(barr[3] <> 0) or (barr[4] <> 255) then
begin
Writeln('Error!');
Halt(1);
end;
{$ENDIF}
FillChar(barr, SizeOf(barr), $ff);
asm
mov w, 2
end;
if (barr[0] <> 2) or (barr[1] <> 0) or (barr[2] <> 255) then
begin
Writeln('Error!');
Halt(1);
end;
FillChar(barr, SizeOf(barr), $ff);
asm
mov b, 1
end;
if (barr[0] <> 1) or (barr[1] <> 255) or (barr[2] <> 255) then
begin
Writeln('Error!');
Halt(1);
end;
Writeln('Ok!');
end.

View File

@ -0,0 +1,60 @@
{ %cpu=i8086 }
{ this test is Turbo Pascal 7 compatible }
program tasmabs2;
{$IFDEF FPC}
{$ASMMODE INTEL}
{$ASMCPU 80386}
{$ENDIF}
var
l: longint absolute $B800:0;
w: word absolute $B800:0;
b: byte absolute $B800:0;
begin
{$IFDEF FPC}
MemL[$B800:0] := MaxLongInt;
MemL[$B800:4] := MaxLongInt;
asm
mov ax, 0b800h
mov es, ax
seges
mov l, 4
end;
if (Mem[$B800:0] <> 4) or (Mem[$B800:1] <> 0) or (Mem[$B800:2] <> 0) or
(Mem[$B800:3] <> 0) or (Mem[$B800:4] <> 255) then
begin
Writeln('Error!');
Halt(1);
end;
{$ENDIF}
MemL[$B800:0] := MaxLongInt;
MemL[$B800:4] := MaxLongInt;
asm
mov ax, 0b800h
mov es, ax
seges
mov w, 2
end;
if (Mem[$B800:0] <> 2) or (Mem[$B800:1] <> 0) or (Mem[$B800:2] <> 255) then
begin
Writeln('Error!');
Halt(1);
end;
MemL[$B800:0] := MaxLongInt;
MemL[$B800:4] := MaxLongInt;
asm
mov ax, 0b800h
mov es, ax
seges
mov b, 1
end;
if (Mem[$B800:0] <> 1) or (Mem[$B800:1] <> 255) or (Mem[$B800:2] <> 255) then
begin
Writeln('Error!');
Halt(1);
end;
Writeln('Ok!');
end.