d0p1/ack
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Addition of some changes by Kees Visser.

Browse source 
In packed structures, subrange types now occupy 1 byte if they fit in
1 byte, they occupy 2 bytes if they fit in 2, etc.
This commit is contained in:
ceriel 1986-10-09 11:09:27 +00:00
parent 9d54fe57f8
commit ec2b3e61c6
1 changed files with 28 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

32
lang/pc/pem/pem.p
View file

@ -36,7 +36,7 @@
{$s+ : test conformancy to standard} {$s+ : test conformancy to standard}
#endif #endif
program pem(input,output,em,errors); program pem(input,em,errors);
{/* {/*
This Pascal compiler produces EM code as described in This Pascal compiler produces EM code as described in
- A.S.Tanenbaum, J.W.Stevenson & H. van Staveren, - A.S.Tanenbaum, J.W.Stevenson & H. van Staveren,
@ -79,6 +79,8 @@ const
{fundamental constants} {fundamental constants}
MB1 = 7; MB1 = 7;
NB1 = 8; NB1 = 8;
MI1 = 127;
NI1 = 128;
MI2 = 32767; MI2 = 32767;
MU1 = 255; MU1 = 255;
NU1 = 256; NU1 = 256;
@ -541,6 +543,7 @@ begin
put1(i1); put1(i2) put1(i1); put1(i2)
end; end;
#if EM_WSIZE == 4
procedure put4(i:integer); procedure put4(i:integer);
var i1,i2:integer; var i1,i2:integer;
begin begin
@ -551,6 +554,7 @@ begin
put1(i1 mod NU1); put1(i1 div NU1); put1(i1 mod NU1); put1(i1 div NU1);
put1(i2 mod NU1); put1(i2 div NU1) put1(i2 mod NU1); put1(i2 div NU1)
end; end;
#endif
procedure argend; procedure argend;
begin put1(sp_cend) end; begin put1(sp_cend) end;
@ -559,9 +563,14 @@ procedure argcst(i:integer);
begin begin
if (i >= -sp_zcst0) and (i < sp_ncst0-sp_zcst0) then if (i >= -sp_zcst0) and (i < sp_ncst0-sp_zcst0) then
put1(i + sp_zcst0 + sp_fcst0) put1(i + sp_zcst0 + sp_fcst0)
else if (i >= -MI2-1) and (i <= MI2) then else
#if EM_WSIZE == 4
if (i >= -MI2-1) and (i <= MI2) then
#endif
begin put1(sp_cst2); put2(i) end begin put1(sp_cst2); put2(i) end
#if EM_WSIZE == 4
else begin put1(sp_cst4); put4(i) end else begin put1(sp_cst4); put4(i) end
#endif
end; end;
procedure argnil; procedure argnil;
@ -864,6 +873,11 @@ begin with a do begin sz:=sizeof(asp,packbit);
gencst(op_lar,sz_word); gencst(op_lar,sz_word);
end; {case} end; {case}
ak:=loaded; ak:=loaded;
if asp^.form = subrange then
if sz < sz_word then
if asp^.min < 0 then
{ do sign extension }
begin gencst(op_loc, sz); gencst(op_loc, sz_word); genop(op_cii) end
end end; end end;
procedure store; procedure store;
@ -1500,7 +1514,11 @@ begin lsp:=nil;
if lip<>nil then if lip<>nil then
begin enterid(lip); hip:=lip; lip^.value:=max; max:=max+1 end; begin enterid(lip); hip:=lip; lip^.value:=max; max:=max+1 end;
until endofloop(fsys+[rparent],[ident],comma,+027); {+028} until endofloop(fsys+[rparent],[ident],comma,+027); {+028}
if max<=MU1 then lsp^.size:=sz_byte; if max<=MU1 then lsp^.size:=sz_byte
#if EM_WSIZE == 4
else if max <= MU2 then lsp^.size = 2*sz_byte
#endif
;
lsp^.fconst:=hip; top:=lnp; nextif(rparent,+029); lsp^.fconst:=hip; top:=lnp; nextif(rparent,+029);
end end
else else
@ -1520,7 +1538,13 @@ begin lsp:=nil;
lsp^.rangetype:=lsp1; lsp^.rangetype:=lsp1;
nextif(colon2,+031); max:=cstinteger(fsys,lsp1,+032); nextif(colon2,+031); max:=cstinteger(fsys,lsp1,+032);
if min>max then begin error(+033); max:=min end; if min>max then begin error(+033); max:=min end;
if (min>=0) and (max<=MU1) then lsp^.size:=sz_byte; if ((min>=0) and (max<=MU1)) or ((min>=-NI1) and (max<=MI1)) then
lsp^.size:=sz_byte
#if EM_WSIZE == 4
else if ((min>=0) and (max<=MU2)) or ((min>=-MI2-1) and (max<=MI2)) then
lsp^.size := 2*sz_byte
#endif
;
lsp^.min:=min; lsp^.max:=max lsp^.min:=min; lsp^.max:=max
end end
end; end;