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

* Disable use of goto for webassembly

Browse Source 
(cherry picked from commit 935ce7edac)
This commit is contained in:
Michaël Van Canneyt 2023-07-11 14:34:45 +02:00 committed by marcoonthegit
parent 40fa147d20
commit 5552402fce
2 changed files with 417 additions and 337 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

708
packages/paszlib/src/infblock.pas
View File

@ -1,7 +1,5 @@
unit infblock;
{$goto on}
{ infblock.h and
infblock.c -- interpret and process block types to last block
Copyright (C) 1995-1998 Mark Adler
@ -172,10 +170,6 @@ end;
function inflate_blocks (var s : inflate_blocks_state;
var z : z_stream;
r : integer) : integer; { initial return code }
label
start_btree, start_dtree,
start_blkdone, start_dry,
start_codes;
var
t : cardinal; { temporary storage }
@ -194,6 +188,350 @@ var
i, j, c : cardinal;
var
cs : pInflate_codes_state;
procedure do_btree;
begin
while (s.sub.trees.index < 4 + (s.sub.trees.table shr 10)) do
begin
{NEEDBITS(3);}
while (k < 3) do
begin
{NEEDBYTE;}
if (n <> 0) then
r :=Z_OK
else
begin
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptruint(p)-ptruint(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
end;
dec(n);
b := b or (cardinal(p^) shl k);
Inc(p);
Inc(k, 8);
end;
s.sub.trees.blens^[border[s.sub.trees.index]] := cardinal(b) and 7;
Inc(s.sub.trees.index);
{DUMPBITS(3);}
b := b shr 3;
dec(k, 3);
end;
while (s.sub.trees.index < 19) do
begin
s.sub.trees.blens^[border[s.sub.trees.index]] := 0;
Inc(s.sub.trees.index);
end;
s.sub.trees.bb := 7;
t := inflate_trees_bits(s.sub.trees.blens^, s.sub.trees.bb,
s.sub.trees.tb, s.hufts^, z);
if (t <> Z_OK) then
begin
freemem(s.sub.trees.blens);
s.sub.trees.blens := nil;
r := t;
if (r = Z_DATA_ERROR) then
s.mode := BLKBAD;
{ update pointers and return }
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptruint(p) - ptruint(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
end;
s.sub.trees.index := 0;
{$IFDEF ZLIB_DEBUG}
Tracev('inflate: bits tree ok');
{$ENDIF}
s.mode := DTREE;
{ fall through again }
end;
procedure do_dtree;
begin
while TRUE do
begin
t := s.sub.trees.table;
if not (s.sub.trees.index < 258 +
(t and $1f) + ((t shr 5) and $1f)) then
break;
t := s.sub.trees.bb;
{NEEDBITS(t);}
while (k < t) do
begin
{NEEDBYTE;}
if (n <> 0) then
r :=Z_OK
else
begin
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptruint(p)-ptruint(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
end;
dec(n);
b := b or (cardinal(p^) shl k);
Inc(p);
Inc(k, 8);
end;
h := s.sub.trees.tb;
Inc(h, cardinal(b) and inflate_mask[t]);
t := h^.Bits;
c := h^.Base;
if (c < 16) then
begin
{DUMPBITS(t);}
b := b shr t;
dec(k, t);
s.sub.trees.blens^[s.sub.trees.index] := c;
Inc(s.sub.trees.index);
end
else { c = 16..18 }
begin
if c = 18 then
begin
i := 7;
j := 11;
end
else
begin
i := c - 14;
j := 3;
end;
{NEEDBITS(t + i);}
while (k < t + i) do
begin
{NEEDBYTE;}
if (n <> 0) then
r :=Z_OK
else
begin
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptruint(p)-ptruint(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
end;
dec(n);
b := b or (cardinal(p^) shl k);
Inc(p);
Inc(k, 8);
end;
{DUMPBITS(t);}
b := b shr t;
dec(k, t);
Inc(j, cardinal(b) and inflate_mask[i]);
{DUMPBITS(i);}
b := b shr i;
dec(k, i);
i := s.sub.trees.index;
t := s.sub.trees.table;
if (i + j > 258 + (t and $1f) + ((t shr 5) and $1f)) or
((c = 16) and (i < 1)) then
begin
freemem(s.sub.trees.blens);
s.sub.trees.blens := nil;
s.mode := BLKBAD;
z.msg := 'invalid bit length repeat';
r := Z_DATA_ERROR;
{ update pointers and return }
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptruint(p) - ptruint(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
end;
if c = 16 then
c := s.sub.trees.blens^[i - 1]
else
c := 0;
repeat
s.sub.trees.blens^[i] := c;
Inc(i);
dec(j);
until (j=0);
s.sub.trees.index := i;
end;
end; { while }
s.sub.trees.tb := nil;
begin
bl := 9; { must be <= 9 for lookahead assumptions }
bd := 6; { must be <= 9 for lookahead assumptions }
t := s.sub.trees.table;
t := inflate_trees_dynamic(257 + (t and $1f),
1 + ((t shr 5) and $1f),
s.sub.trees.blens^, bl, bd, tl, td, s.hufts^, z);
freemem(s.sub.trees.blens);
s.sub.trees.blens := nil;
if (t <> Z_OK) then
begin
if (t = cardinal(Z_DATA_ERROR)) then
s.mode := BLKBAD;
r := t;
{ update pointers and return }
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptruint(p) - ptruint(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
end;
{$IFDEF ZLIB_DEBUG}
Tracev('inflate: trees ok');
{$ENDIF}
{ c renamed to cs }
cs := inflate_codes_new(bl, bd, tl, td, z);
if (cs = nil) then
begin
r := Z_MEM_ERROR;
{ update pointers and return }
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptruint(p) - ptruint(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
end;
s.sub.decode.codes := cs;
end;
s.mode := CODES;
end;
function do_codes: boolean;
begin
{ update pointers }
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptruint(p) - ptruint(z.next_in));
z.next_in := p;
s.write := q;
r := inflate_codes(s, z, r);
if (r <> Z_STREAM_END) then
begin
inflate_blocks := inflate_flush(s, z, r);
exit;
end;
r := Z_OK;
inflate_codes_free(s.sub.decode.codes, z);
{ load local pointers }
p := z.next_in;
n := z.avail_in;
b := s.bitb;
k := s.bitk;
q := s.write;
if ptruint(q) < ptruint(s.read) then
m := cardinal(ptruint(s.read)-ptruint(q)-1)
else
m := cardinal(ptruint(s.zend)-ptruint(q));
{$IFDEF ZLIB_DEBUG}
if (ptruint(q) >= ptruint(s.read)) then
Tracev('inflate: codes end '+
IntToStr(z.total_out + ptruint(q) - ptruint(s.read)) + ' total out')
else
Tracev('inflate: codes end '+
IntToStr(z.total_out + ptruint(s.zend) - ptruint(s.read) +
ptruint(q) - ptruint(s.window)) + ' total out');
{$ENDIF}
if (not s.last) then
begin
s.mode := ZTYPE;
exit(false); { break for switch statement in C-code }
end;
{$ifndef patch112}
if (k > 7) then { return unused byte, if any }
begin
{$IFDEF ZLIB_DEBUG}
Assert(k < 16, 'inflate_codes grabbed too many bytes');
{$ENDIF}
dec(k, 8);
inc(n);
dec(p); { can always return one }
end;
{$endif}
s.mode := DRY;
do_codes:=true;
end;
procedure do_dry;
begin
{FLUSH}
s.write := q;
r := inflate_flush(s,z,r);
q := s.write;
{ not needed anymore, we are done:
if ptruint(q) < ptruint(s.read) then
m := cardinal(ptruint(s.read)-ptruint(q)-1)
else
m := cardinal(ptruint(s.zend)-ptruint(q));
}
if (s.read <> s.write) then
begin
{ update pointers and return }
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptruint(p) - ptruint(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
end;
s.mode := BLKDONE;
end;
procedure do_blkdone;
begin
r := Z_STREAM_END;
{ update pointers and return }
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptruint(p) - ptruint(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
end;
begin
{ copy input/output information to locals }
p := z.next_in;
@ -542,350 +880,50 @@ begin
s.mode := BTREE;
{ fall trough case is handled by the while }
{ try GOTO for speed - Nomssi }
goto start_btree;
do_btree;
do_dtree;
if not do_codes then
continue;
do_dry;
do_blkdone;
exit;
end;
BTREE:
begin
start_btree:
while (s.sub.trees.index < 4 + (s.sub.trees.table shr 10)) do
begin
{NEEDBITS(3);}
while (k < 3) do
begin
{NEEDBYTE;}
if (n <> 0) then
r :=Z_OK
else
begin
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptruint(p)-ptruint(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
end;
dec(n);
b := b or (cardinal(p^) shl k);
Inc(p);
Inc(k, 8);
end;
s.sub.trees.blens^[border[s.sub.trees.index]] := cardinal(b) and 7;
Inc(s.sub.trees.index);
{DUMPBITS(3);}
b := b shr 3;
dec(k, 3);
end;
while (s.sub.trees.index < 19) do
begin
s.sub.trees.blens^[border[s.sub.trees.index]] := 0;
Inc(s.sub.trees.index);
end;
s.sub.trees.bb := 7;
t := inflate_trees_bits(s.sub.trees.blens^, s.sub.trees.bb,
s.sub.trees.tb, s.hufts^, z);
if (t <> Z_OK) then
begin
freemem(s.sub.trees.blens);
s.sub.trees.blens := nil;
r := t;
if (r = Z_DATA_ERROR) then
s.mode := BLKBAD;
{ update pointers and return }
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptruint(p) - ptruint(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
end;
s.sub.trees.index := 0;
{$IFDEF ZLIB_DEBUG}
Tracev('inflate: bits tree ok');
{$ENDIF}
s.mode := DTREE;
{ fall through again }
goto start_dtree;
do_btree;
do_dtree;
if not do_codes then
continue;
do_dry;
do_blkdone;
exit;
end;
DTREE:
begin
start_dtree:
while TRUE do
begin
t := s.sub.trees.table;
if not (s.sub.trees.index < 258 +
(t and $1f) + ((t shr 5) and $1f)) then
break;
t := s.sub.trees.bb;
{NEEDBITS(t);}
while (k < t) do
begin
{NEEDBYTE;}
if (n <> 0) then
r :=Z_OK
else
begin
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptruint(p)-ptruint(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
end;
dec(n);
b := b or (cardinal(p^) shl k);
Inc(p);
Inc(k, 8);
end;
h := s.sub.trees.tb;
Inc(h, cardinal(b) and inflate_mask[t]);
t := h^.Bits;
c := h^.Base;
if (c < 16) then
begin
{DUMPBITS(t);}
b := b shr t;
dec(k, t);
s.sub.trees.blens^[s.sub.trees.index] := c;
Inc(s.sub.trees.index);
end
else { c = 16..18 }
begin
if c = 18 then
begin
i := 7;
j := 11;
end
else
begin
i := c - 14;
j := 3;
end;
{NEEDBITS(t + i);}
while (k < t + i) do
begin
{NEEDBYTE;}
if (n <> 0) then
r :=Z_OK
else
begin
{UPDATE}
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptruint(p)-ptruint(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
end;
dec(n);
b := b or (cardinal(p^) shl k);
Inc(p);
Inc(k, 8);
end;
{DUMPBITS(t);}
b := b shr t;
dec(k, t);
Inc(j, cardinal(b) and inflate_mask[i]);
{DUMPBITS(i);}
b := b shr i;
dec(k, i);
i := s.sub.trees.index;
t := s.sub.trees.table;
if (i + j > 258 + (t and $1f) + ((t shr 5) and $1f)) or
((c = 16) and (i < 1)) then
begin
freemem(s.sub.trees.blens);
s.sub.trees.blens := nil;
s.mode := BLKBAD;
z.msg := 'invalid bit length repeat';
r := Z_DATA_ERROR;
{ update pointers and return }
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptruint(p) - ptruint(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
end;
if c = 16 then
c := s.sub.trees.blens^[i - 1]
else
c := 0;
repeat
s.sub.trees.blens^[i] := c;
Inc(i);
dec(j);
until (j=0);
s.sub.trees.index := i;
end;
end; { while }
s.sub.trees.tb := nil;
begin
bl := 9; { must be <= 9 for lookahead assumptions }
bd := 6; { must be <= 9 for lookahead assumptions }
t := s.sub.trees.table;
t := inflate_trees_dynamic(257 + (t and $1f),
1 + ((t shr 5) and $1f),
s.sub.trees.blens^, bl, bd, tl, td, s.hufts^, z);
freemem(s.sub.trees.blens);
s.sub.trees.blens := nil;
if (t <> Z_OK) then
begin
if (t = cardinal(Z_DATA_ERROR)) then
s.mode := BLKBAD;
r := t;
{ update pointers and return }
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptruint(p) - ptruint(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
end;
{$IFDEF ZLIB_DEBUG}
Tracev('inflate: trees ok');
{$ENDIF}
{ c renamed to cs }
cs := inflate_codes_new(bl, bd, tl, td, z);
if (cs = nil) then
begin
r := Z_MEM_ERROR;
{ update pointers and return }
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptruint(p) - ptruint(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
end;
s.sub.decode.codes := cs;
end;
s.mode := CODES;
{ yet another falltrough }
goto start_codes;
do_dtree;
if not do_codes then
continue;
do_dry;
do_blkdone;
exit;
end;
CODES:
begin
start_codes:
{ update pointers }
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptruint(p) - ptruint(z.next_in));
z.next_in := p;
s.write := q;
r := inflate_codes(s, z, r);
if (r <> Z_STREAM_END) then
begin
inflate_blocks := inflate_flush(s, z, r);
exit;
end;
r := Z_OK;
inflate_codes_free(s.sub.decode.codes, z);
{ load local pointers }
p := z.next_in;
n := z.avail_in;
b := s.bitb;
k := s.bitk;
q := s.write;
if ptruint(q) < ptruint(s.read) then
m := cardinal(ptruint(s.read)-ptruint(q)-1)
else
m := cardinal(ptruint(s.zend)-ptruint(q));
{$IFDEF ZLIB_DEBUG}
if (ptruint(q) >= ptruint(s.read)) then
Tracev('inflate: codes end '+
IntToStr(z.total_out + ptruint(q) - ptruint(s.read)) + ' total out')
else
Tracev('inflate: codes end '+
IntToStr(z.total_out + ptruint(s.zend) - ptruint(s.read) +
ptruint(q) - ptruint(s.window)) + ' total out');
{$ENDIF}
if (not s.last) then
begin
s.mode := ZTYPE;
continue; { break for switch statement in C-code }
end;
{$ifndef patch112}
if (k > 7) then { return unused byte, if any }
begin
{$IFDEF ZLIB_DEBUG}
Assert(k < 16, 'inflate_codes grabbed too many bytes');
{$ENDIF}
dec(k, 8);
inc(n);
dec(p); { can always return one }
end;
{$endif}
s.mode := DRY;
{ another falltrough }
goto start_dry;
if not do_codes then
continue;
do_dry;
do_blkdone;
exit;
end;
DRY:
begin
start_dry:
{FLUSH}
s.write := q;
r := inflate_flush(s,z,r);
q := s.write;
{ not needed anymore, we are done:
if ptruint(q) < ptruint(s.read) then
m := cardinal(ptruint(s.read)-ptruint(q)-1)
else
m := cardinal(ptruint(s.zend)-ptruint(q));
}
if (s.read <> s.write) then
begin
{ update pointers and return }
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptruint(p) - ptruint(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
exit;
end;
s.mode := BLKDONE;
goto start_blkdone;
do_dry;
do_blkdone;
exit;
end;
BLKDONE:
begin
start_blkdone:
r := Z_STREAM_END;
{ update pointers and return }
s.bitb := b;
s.bitk := k;
z.avail_in := n;
Inc(z.total_in, ptruint(p) - ptruint(z.next_in));
z.next_in := p;
s.write := q;
inflate_blocks := inflate_flush(s,z,r);
do_blkdone;
exit;
end;
BLKBAD:

46
packages/paszlib/src/zdeflate.pas
View File

@ -1,6 +1,12 @@
unit ZDeflate;
{$IFDEF CPUWASM}
{$DEFINE NOGOTO}
{$ENDIF}
{$IFNDEF NOGOTO}
{$goto on}
{$ENDIF}
{ Orginal: deflate.h -- internal compression state
deflate.c -- compress data using the deflation algorithm
@ -1206,8 +1212,7 @@ end;
function longest_match(var s : deflate_state;
cur_match : IPos { current match }
) : cardinal;
label
nextstep;
var
chain_length : cardinal; { max hash chain length }
{register} scan : Pbyte; { current string }
@ -1230,6 +1235,19 @@ var
{$endif}
var
MAX_DIST : cardinal;
{$IFNDEF NOGOTO}
label
nextstep;
{$ELSE}
Procedure DoNextStep; inline;
begin
cur_match := prev^[cur_match and wmask];
dec(chain_length);
end;
{$ENDIF}
begin
chain_length := s.max_chain_length; { max hash chain length }
scan := @(s.window^[s.strstart]);
@ -1307,7 +1325,15 @@ distances are limited to MAX_DIST instead of WSIZE. }
{$PUSH} {$R-}
if (match[best_len-1]<>scan_end) or
(match^ <> scan_start) then
{$IFDEF NOGOTO}
begin
DoNextStep;
Continue;
end;
{$ELSE}
goto nextstep; {continue;}
{$ENDIF}
{$POP}
{ It is not necessary to compare scan[2] and match[2] since they are
@ -1353,11 +1379,25 @@ distances are limited to MAX_DIST instead of WSIZE. }
if (Pbytearray(match)^[best_len] <> scan_end) or
(Pbytearray(match)^[best_len-1] <> scan_end1) or
(match^ <> scan^) then
{$IFDEF NOGOTO}
begin
DoNextStep;
Continue;
end;
{$ELSE}
goto nextstep; {continue;}
{$ENDIF}
{$POP}
inc(match);
if (match^ <> Pbytearray(scan)^[1]) then
{$IFDEF NOGOTO}
begin
DoNextStep;
Continue;
end;
{$ELSE}
goto nextstep; {continue;}
{$ENDIF}
{ The check at best_len-1 can be removed because it will be made
again later. (This heuristic is not always a win.)
@ -1411,9 +1451,11 @@ distances are limited to MAX_DIST instead of WSIZE. }
{$endif}
{$pop}
end;
{$ifndef NOGOTO}
nextstep:
cur_match := prev^[cur_match and wmask];
dec(chain_length);
{$ENDIF}
until (cur_match <= limit) or (chain_length = 0);
if (cardinal(best_len) <= s.lookahead) then