fpc/rtl/inc/generic.inc

{
    This file is part of the Free Pascal run time library.
    Copyright (c) 1999-2000 by the Free Pascal development team.

    Processor independent implementation for the system unit
    (adapted for intel i386.inc file)

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}

function align(addr : PtrUInt;alignment : PtrUInt) : PtrUInt;{$ifdef SYSTEMINLINE}inline;{$endif}
  var
    tmp: PtrUInt;
  begin
    tmp:=addr+PtrUInt(alignment-1);
    result:=tmp-(tmp mod alignment)
  end;


{$ifndef cpujvm}
function align(addr : Pointer;alignment : PtrUInt) : Pointer;{$ifdef SYSTEMINLINE}inline;{$endif}
  var
    tmp: PtrUInt;
  begin
    tmp:=PtrUInt(addr)+(alignment-1);
    result:=pointer(ptruint(tmp-(tmp mod alignment)));
  end;
{$endif}

{****************************************************************************
                               Primitives
****************************************************************************}
type
  pstring = ^shortstring;

{$ifndef FPC_HAS_SHORTSTR_SHORTSTR_INTERN_CHARMOVE}
{$define FPC_HAS_SHORTSTR_SHORTSTR_INTERN_CHARMOVE}
procedure fpc_shortstr_shortstr_intern_charmove(const src: shortstring; const srcindex: byte; var dst: shortstring; const dstindex, len: byte); {$ifdef SYSTEMINLINE}inline;{$endif}
begin
  move(src[srcindex],dst[dstindex],len);
end;
{$endif FPC_HAS_SHORTSTR_SHORTSTR_INTERN_CHARMOVE}

{$ifndef FPC_HAS_SHORTSTR_CHARARRAY_INTERN_CHARMOVE}
{$define FPC_HAS_SHORTSTR_CHARARRAY_INTERN_CHARMOVE}
procedure fpc_shortstr_chararray_intern_charmove(const src: shortstring; out dst: array of char; const len: sizeint);
begin
  move(src[1],pchar(@dst)^,len);
end;
{$endif FPC_HAS_SHORTSTR_CHARARRAY_INTERN_CHARMOVE}


{$ifndef FPC_SYSTEM_HAS_MOVE}
procedure Move(const source;var dest;count:SizeInt);[public, alias: 'FPC_MOVE'];
var
  aligncount : sizeint;
  pdest,psrc,pend : pbyte;
begin
  if (@dest=@source) or (count<=0) then
    exit;
  if (@dest<@source) or (@source+count<@dest) then
    begin
      { Forward Move }
      psrc:=@source;
      pdest:=@dest;
      if (Count>4*sizeof(ptruint)-11)
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
        and ((PtrUInt(pdest) and (sizeof(PtrUInt)-1))=(PtrUInt(psrc) and (sizeof(PtrUInt)-1)))
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
        then
        begin
          { Align on native pointer size }
          aligncount:=(sizeof(PtrUInt)-PtrInt(pdest)) and (sizeof(PtrUInt)-1);
          dec(count,aligncount);
          pend:=psrc+aligncount;
          while psrc<pend do
            begin
              pdest^:=psrc^;
              inc(pdest);
              inc(psrc);
            end;
          { use sizeuint typecast to force shr optimization }
          pptruint(pend):=pptruint(psrc)+(sizeuint(count) div sizeof(ptruint));
          while psrc<pend do
            begin
              pptruint(pdest)^:=pptruint(psrc)^;
              inc(pptruint(pdest));
              inc(pptruint(psrc));
            end;
          count:=count and (sizeof(PtrUInt)-1);
        end;
      pend:=psrc+count;
      while psrc<pend do
        begin
          pdest^:=psrc^;
          inc(pdest);
          inc(psrc);
        end;
    end
  else
    begin
      { Backward Move }
      psrc:=@source+count;
      pdest:=@dest+count;
      if (Count>4*sizeof(ptruint)-11)
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
        and ((PtrUInt(pdest) and (sizeof(PtrUInt)-1))=(PtrUInt(psrc) and (sizeof(PtrUInt)-1)))
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
        then
        begin
          { Align on native pointer size }
          aligncount:=(PtrUInt(pdest) and (sizeof(PtrUInt)-1));
          dec(count,aligncount);
          pend:=psrc-aligncount;
          while psrc>pend do
            begin
              dec(pdest);
              dec(psrc);
              pdest^:=psrc^;
            end;
          { use sizeuint typecast to force shr optimization }
          pptruint(pend):=pptruint(psrc)-(sizeuint(count) div sizeof(ptruint));
          while psrc>pend do
            begin
              dec(pptruint(pdest));
              dec(pptruint(psrc));
              pptruint(pdest)^:=pptruint(psrc)^;
            end;
          count:=count and (sizeof(PtrUInt)-1);
        end;
      pend:=psrc-count;
      while psrc>pend do
        begin
          dec(pdest);
          dec(psrc);
          pdest^:=psrc^;
        end;
    end;
end;
{$endif not FPC_SYSTEM_HAS_MOVE}


{$ifndef FPC_SYSTEM_HAS_FILLCHAR}
Procedure FillChar(var x;count:SizeInt;value:byte);
var
  pdest,pend : pbyte;
  v : ALUUInt;
begin
  if count <= 0 then
    exit;
  pdest:=@x;
  if Count>4*sizeof(ptruint)-1 then
    begin
{$if sizeof(v)>=2}
      v:=(value shl 8) or value;
{$endif sizeof(v)>=2}
{$if sizeof(v)>=4}
      v:=(v shl 16) or v;
{$endif sizeof(v)>=4}
{$if sizeof(v)=8}
      v:=(v shl 32) or v;
{$endif sizeof(v)=8}
      { Align on native pointer size }
      pend:=pbyte(align(pdest,sizeof(PtrUInt)));
      dec(count,pend-pdest);
      while pdest<pend do
        begin
          pdest^:=value;
          inc(pdest);
        end;
      { use sizeuint typecast to force shr optimization }
      pptruint(pend):=pptruint(pdest)+(sizeuint(count) div sizeof(ptruint));
      while pdest<pend do
        begin
          pptruint(pdest)^:=v;
          inc(pptruint(pdest));
        end;
      count:=count and (sizeof(ptruint)-1);
    end;
  pend:=pdest+count;
  while pdest<pend do
    begin
      pdest^:=value;
      inc(pdest);
    end;
end;
{$endif FPC_SYSTEM_HAS_FILLCHAR}


{$ifndef FPC_SYSTEM_HAS_FILLWORD}
procedure fillword(var x;count : SizeInt;value : word);
var
  aligncount : sizeint;
  pdest,pend : pword;
  v : ALUUInt;
begin
  if count <= 0 then
    exit;
  pdest:=@x;
  if Count>4*sizeof(ptruint)-1 then
    begin
{$if sizeof(v)>=4}
      v:=(value shl 16) or value;
{$endif sizeof(v)>=4}
{$if sizeof(v)=8}
      v:=(v shl 32) or v;
{$endif sizeof(v)=8}
      { Align on native pointer size }
      aligncount:=(PtrUInt(pdest) and (sizeof(PtrUInt)-1)) shr 1;
      dec(count,aligncount);
      pend:=pdest+aligncount;
      while pdest<pend do
        begin
          pdest^:=value;
          inc(pdest);
        end;
      { use sizeuint typecast to force shr optimization }
      pptruint(pend):=pptruint(pdest)+((sizeuint(count)*2) div sizeof(ptruint));
      while pdest<pend do
        begin
          pptruint(pdest)^:=v;
          inc(pptruint(pdest));
        end;
      count:=((count*2) and (sizeof(ptruint)-1)) shr 1;
    end;
  pend:=pdest+count;
  while pdest<pend do
    begin
      pdest^:=value;
      inc(pdest);
    end;
end;
{$endif not FPC_SYSTEM_HAS_FILLWORD}


{$ifndef FPC_SYSTEM_HAS_FILLDWORD}
procedure filldword(var x;count : SizeInt;value : dword);
var
  aligncount : sizeint;
  pdest,pend : pdword;
  v : ALUUInt;
begin
  if count <= 0 then
    exit;
  pdest:=@x;
  if Count>4*sizeof(ptruint)-1 then
    begin
      v:=value;
{$if sizeof(v)=8}
      v:=(v shl 32) or v;
{$endif sizeof(v)=8}
      { Align on native pointer size }
      aligncount:=(PtrUInt(pdest) and (sizeof(PtrUInt)-1)) shr 2;
      dec(count,aligncount);
      pend:=pdest+aligncount;
      while pdest<pend do
        begin
          pdest^:=value;
          inc(pdest);
        end;
      { use sizeuint typecast to force shr optimization }
      pptruint(pend):=pptruint(pdest)+((sizeuint(count)*4) div sizeof(ptruint));
      while pdest<pend do
        begin
          pptruint(pdest)^:=v;
          inc(pptruint(pdest));
        end;
      count:=((count*4) and (sizeof(ptruint)-1)) shr 2;
    end;
  pend:=pdest+count;
  while pdest<pend do
    begin
      pdest^:=value;
      inc(pdest);
    end;
end;
{$endif FPC_SYSTEM_HAS_FILLDWORD}


{$ifndef FPC_SYSTEM_HAS_FILLQWORD}
procedure fillqword(var x;count : SizeInt;value : qword);
var
  pdest,pend : pqword;
begin
  if count <= 0 then
    exit;
  pdest:=@x;
  pend:=pdest+count;
  while pdest<pend do
    begin
      pdest^:=value;
      inc(pdest);
    end;
end;
{$endif FPC_SYSTEM_HAS_FILLQWORD}


{$ifndef FPC_SYSTEM_HAS_INDEXBYTE}
function IndexByte(Const buf;len:SizeInt;b:byte):SizeInt;
var
  psrc,pend : pbyte;
begin
  psrc:=@buf;
  { simulate assembler implementations behaviour, which is expected }
  { fpc_pchar_to_ansistr in astrings.inc                            }
  if (len < 0) or
     (psrc+len < psrc) then
    pend:=pbyte(high(PtrUInt)-sizeof(byte))
  else
    pend:=psrc+len;
  while (psrc<pend) do
    begin
      if psrc^=b then
        begin
          result:=psrc-pbyte(@buf);
          exit;
        end;
      inc(psrc);
    end;
  result:=-1;
end;
{$endif not FPC_SYSTEM_HAS_INDEXBYTE}


{$ifndef FPC_SYSTEM_HAS_INDEXWORD}
function Indexword(Const buf;len:SizeInt;b:word):SizeInt;
var
  psrc,pend : pword;
begin
  psrc:=@buf;
  { simulate assembler implementations behaviour, which is expected }
  { fpc_pchar_to_ansistr in astrings.inc                            }
  if (len < 0) or
     { is this ever true? }
     (len > high(PtrInt)) or
     (psrc+len < psrc) then
    pend:=pword(high(PtrUInt)-sizeof(word))
  else
    pend:=psrc+len;
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
  if (ptruint(psrc) mod 2)<>0 then
    while psrc<pend do
      begin
        if unaligned(psrc^)=b then
          begin
            result:=psrc-pword(@buf);
            exit;
          end;
        inc(psrc);
      end
  else
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
    while psrc<pend do
      begin
        if psrc^=b then
          begin
            result:=psrc-pword(@buf);
            exit;
          end;
        inc(psrc);
      end;
  result:=-1;
end;
{$endif not FPC_SYSTEM_HAS_INDEXWORD}


{$ifndef FPC_SYSTEM_HAS_INDEXDWORD}
function IndexDWord(Const buf;len:SizeInt;b:DWord):SizeInt;
var
  psrc,pend : pdword;
begin
  psrc:=@buf;
  { simulate assembler implementations behaviour, which is expected }
  { fpc_pchar_to_ansistr in astrings.inc                            }
  if (len < 0) or
     (len > high(PtrInt) div 2) or
     (psrc+len < psrc) then
    pend:=pdword(high(PtrUInt)-PtrUInt(sizeof(dword)))
  else
    pend:=psrc+len;
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
  if (ptruint(psrc) mod 4)<>0 then
    while psrc<pend do
      begin
        if unaligned(psrc^)=b then
          begin
            result:=psrc-pdword(@buf);
            exit;
          end;
        inc(psrc);
      end
  else
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
    while psrc<pend do
      begin
        if psrc^=b then
          begin
            result:=psrc-pdword(@buf);
            exit;
          end;
        inc(psrc);
      end;
  result:=-1;
end;
{$endif not FPC_SYSTEM_HAS_INDEXDWORD}


{$ifndef FPC_SYSTEM_HAS_INDEXQWORD}
function IndexQWord(Const buf;len:SizeInt;b:QWord):SizeInt;
var
  psrc,pend : pqword;
begin
  psrc:=@buf;
  { simulate assembler implementations behaviour, which is expected }
  { fpc_pchar_to_ansistr in astrings.inc                            }
  if (len < 0) or
     (len > high(PtrInt) div 4) or
     (psrc+len < psrc) then
    pend:=pqword(high(PtrUInt)-PtrUInt(sizeof(qword)))
  else
    pend:=psrc+len;
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
  if (ptruint(psrc) mod 8)<>0 then
    while psrc<pend do
      begin
        if unaligned(psrc^)=b then
          begin
            result:=psrc-pqword(@buf);
            exit;
          end;
        inc(psrc);
      end
  else
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
    while psrc<pend do
      begin
        if psrc^=b then
          begin
            result:=psrc-pqword(@buf);
            exit;
          end;
        inc(psrc);
      end;
  result:=-1;
end;
{$endif not FPC_SYSTEM_HAS_INDEXQWORD}


{$ifndef FPC_SYSTEM_HAS_COMPAREBYTE}
function CompareByte(Const buf1,buf2;len:SizeInt):SizeInt;
var
  aligncount : sizeint;
  psrc,pdest,pend : pbyte;
  b : ptrint;
begin
  b:=0;
  psrc:=@buf1;
  pdest:=@buf2;
  if (len>4*sizeof(ptruint)-1)
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
    and ((PtrUInt(pdest) and (sizeof(PtrUInt)-1))=(PtrUInt(psrc) and (sizeof(PtrUInt)-1)))
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
    then
    begin
      { Align on native pointer size }
      aligncount:=(sizeof(PtrUInt)-(PtrUInt(pdest) and (sizeof(PtrUInt)-1))) and (sizeof(PtrUInt)-1);
      dec(len,aligncount);
      pend:=psrc+aligncount;
      while psrc<pend do
        begin
          b:=(ptrint(psrc^)-ptrint(pdest^));
          if b<>0 then
            begin
              if b<0 then
                exit(-1)
              else
                exit(1);
            end;
          inc(pdest);
          inc(psrc);
        end;
      { use sizeuint typecast to force shr optimization }
      pptruint(pend):=pptruint(psrc)+(sizeuint(len) div sizeof(ptruint));
      len:=len and (sizeof(PtrUInt)-1);
      while psrc<pend do
        begin
          b:=(pptrint(psrc)^-pptrint(pdest)^);
          if b<>0 then
            begin
              len:=sizeof(ptruint);
              break;
            end;
          inc(pptruint(pdest));
          inc(pptruint(psrc));
        end;
    end;
  if (psrc+len >= psrc) then
    pend:=psrc+len
  else
    pend:=pbyte(high(ptruint)-1);
  while psrc<pend do
    begin
      b:=(ptrint(psrc^)-ptrint(pdest^));
      if b<>0 then
        begin
          if b<0 then
            exit(-1)
          else
            exit(1);
        end;
      inc(pdest);
      inc(psrc);
    end;
  result:=0;
end;
{$endif not FPC_SYSTEM_HAS_COMPAREBYTE}


{$ifndef FPC_SYSTEM_HAS_COMPAREWORD}
function CompareWord(Const buf1,buf2;len:SizeInt):SizeInt;
var
  aligncount : sizeint;
  psrc,pdest,pend : pword;
  b : ptrint;
begin
  b:=0;
  psrc:=@buf1;
  pdest:=@buf2;
  if (len>4*sizeof(ptruint)-1)
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
    and ((PtrUInt(pdest) and (sizeof(PtrUInt)-1))=(PtrUInt(psrc) and (sizeof(PtrUInt)-1)))
    and (((PtrUInt(pdest) and 1) or (PtrUInt(psrc) and 1))=0)
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
    then
     begin
      { Align on native pointer size }
      aligncount:=((sizeof(PtrUInt)-(PtrUInt(pdest) and (sizeof(PtrUInt)-1))) and (sizeof(PtrUInt)-1)) shr 1;
      dec(len,aligncount);
      pend:=psrc+aligncount;
      while psrc<pend do
        begin
          b:=(ptrint(psrc^)-ptrint(pdest^));
          if b<>0 then
            begin
              if b<0 then
                exit(-1)
              else
                exit(1);
            end;
          inc(pdest);
          inc(psrc);
        end;
      { use sizeuint typecast to force shr optimization }
      pptruint(pend):=pptruint(psrc)+(sizeuint(len)*2 div sizeof(ptruint));
      len:=((len*2) and (sizeof(PtrUInt)-1)) shr 1;
      while psrc<pend do
        begin
          b:=(pptrint(psrc)^-pptrint(pdest)^);
          if b<>0 then
            begin
              len:=sizeof(ptruint) shr 1;
              break;
            end;
          inc(pptruint(pdest));
          inc(pptruint(psrc));
        end;
    end;
  if (psrc+len >= psrc) then
    pend:=psrc+len
  else
    pend:=pword(high(ptruint)-2);
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
  if ((PtrUInt(pdest) and 1) or (PtrUInt(psrc) and 1))<>0 then
    while psrc<pend do
      begin
        b:=(ptrint(unaligned(psrc^))-ptrint(unaligned(pdest^)));
        if b<>0 then
          begin
            if b<0 then
              exit(-1)
            else
              exit(1);
          end;
        inc(pdest);
        inc(psrc);
      end
  else
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
    while psrc<pend do
      begin
        b:=(ptrint(psrc^)-ptrint(pdest^));
        if b<>0 then
          begin
            if b<0 then
              exit(-1)
            else
              exit(1);
          end;
        inc(pdest);
        inc(psrc);
      end;
  result:=0;
end;
{$endif not FPC_SYSTEM_HAS_COMPAREWORD}


{$ifndef FPC_SYSTEM_HAS_COMPAREDWORD}
function CompareDWord(Const buf1,buf2;len:SizeInt):SizeInt;
var
  aligncount : sizeint;
  psrc,pdest,pend : pdword;
begin
  psrc:=@buf1;
  pdest:=@buf2;
  if (len>4*sizeof(ptruint)-11)
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
    and ((PtrUInt(pdest) and (sizeof(PtrUInt)-1))=(PtrUInt(psrc) and (sizeof(PtrUInt)-1)))
    and (((PtrUInt(pdest) and 3) or (PtrUInt(psrc) and 3))=0)
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
    then
    begin
      { Align on native pointer size }
      aligncount:=((sizeof(PtrUInt)-(PtrUInt(pdest) and (sizeof(PtrUInt)-1))) and (sizeof(PtrUInt)-1)) shr 2;
      dec(len,aligncount);
      pend:=psrc+aligncount;
      while psrc<pend do
        begin
          if psrc^<>pdest^ then
            if psrc^>pdest^ then
              exit(1)
            else
              exit(-1);
          inc(pdest);
          inc(psrc);
        end;
      { use sizeuint typecast to force shr optimization }
      pptruint(pend):=pptruint(psrc)+(sizeuint(len)*4 div sizeof(ptruint));
      len:=((len*4) and (sizeof(PtrUInt)-1)) shr 2;
      while psrc<pend do
        begin
          if pptrint(psrc)^<>pptrint(pdest)^ then
            begin
              len:=sizeof(ptruint) shr 2;
              break;
            end;
          inc(pptruint(pdest));
          inc(pptruint(psrc));
        end;
    end;
  if (len <= high(ptrint) div 2) and
     (psrc+len >= psrc) then
    pend:=psrc+len
  else
    pend:=pdword(high(ptruint)-4);
{$ifdef FPC_REQUIRES_PROPER_ALIGNMENT}
  if ((PtrUInt(pdest) and 3) or (PtrUInt(psrc) and 3))<>0 then
    while psrc<pend do
      begin
        if unaligned(psrc^)<>unaligned(pdest^) then
          if unaligned(psrc^)>unaligned(pdest^) then
            exit(1)
          else
            exit(-1);
        inc(pdest);
        inc(psrc);
      end
  else
{$endif FPC_REQUIRES_PROPER_ALIGNMENT}
    while psrc<pend do
      begin
        if psrc^<>pdest^ then
          if psrc^>pdest^ then
            exit(1)
          else
            exit(-1);
        inc(pdest);
        inc(psrc);
      end;
  result:=0;
end;
{$endif ndef FPC_SYSTEM_HAS_COMPAREDWORD}


{$ifndef FPC_SYSTEM_HAS_MOVECHAR0}
procedure MoveChar0(Const buf1;var buf2;len:SizeInt);
var
  I : SizeInt;
begin
  if Len = 0 then
    exit;
  I:=IndexByte(Buf1,Len,0);
  if I<>-1 then
    Move(Buf1,Buf2,I)
  else
    Move(Buf1,Buf2,len);
end;
{$endif ndef FPC_SYSTEM_HAS_MOVECHAR0}


{$ifndef FPC_SYSTEM_HAS_INDEXCHAR0}
function IndexChar0(Const buf;len:SizeInt;b:Char):SizeInt;
var
  psrc,pend : pbyte;
begin
  psrc:=@buf;
  { simulate assembler implementations behaviour, which is expected }
  { fpc_pchar_to_ansistr in astrings.inc                            }
  if (len < 0) then
    pend:=pbyte(high(PtrUInt)-PtrUInt(sizeof(byte)))
  else
    pend:=psrc+len;
  while (psrc<pend) and (psrc^<>0) do
    begin
      if (psrc^=byte(b)) then
        begin
          result:=psrc-pbyte(@buf);
          exit;
        end;
      inc(psrc);
    end;
  result:=-1;
end;
{$endif ndef FPC_SYSTEM_HAS_INDEXCHAR0}


{$ifndef FPC_SYSTEM_HAS_COMPARECHAR0}
function CompareChar0(Const buf1,buf2;len:SizeInt):SizeInt;
var
  psrc,pdest,pend : pbyte;
  b : ptrint;
begin
  b:=0;
  psrc:=@buf1;
  pdest:=@buf2;
  pend:=psrc+len;
  while psrc<pend do
    begin
      b:=(ptrint(psrc^)-ptrint(pdest^));
      if b<0 then
        exit(-1)
      else if b>0 then
        exit(1);
      if (psrc^=0) or (pdest^=0) then
        exit(0);
      inc(pdest);
      inc(psrc);
    end;
  result:=0;
end;
{$endif not FPC_SYSTEM_HAS_COMPARECHAR0}


{****************************************************************************
                              Object Helpers
****************************************************************************}

{$ifdef FPC_HAS_FEATURE_OBJECTS}
type
  pobjectvmt=^tobjectvmt;
  tobjectvmt=record
    size,msize:sizeuint;
    parent:{$ifdef VER3_0}pointer{$else}ppointer{$endif};
  end;

{$ifndef FPC_SYSTEM_HAS_FPC_HELP_CONSTRUCTOR}
{ Note: _vmt will be reset to -1 when memory is allocated,
  this is needed for fpc_help_fail }
function fpc_help_constructor(_self:pointer;var _vmt:pointer;_vmt_pos:cardinal):pointer;[public,alias:'FPC_HELP_CONSTRUCTOR'];compilerproc;
var
  vmtcopy : pobjectvmt;
begin
  vmtcopy:=pobjectvmt(_vmt);
  { Inherited call? }
  if vmtcopy=nil then
    begin
      fpc_help_constructor:=_self;
      exit;
    end;

  if (_self=nil) and
     (vmtcopy^.size>0) then
    begin
      getmem(_self,vmtcopy^.size);
      { reset vmt needed for fail }
      _vmt:=pointer(-1);
    end;
  if _self<>nil then
    begin
      fillchar(_self^,vmtcopy^.size,0);
      ppointer(_self+_vmt_pos)^:=vmtcopy;
    end;
  fpc_help_constructor:=_self;
end;
{$endif FPC_SYSTEM_HAS_FPC_HELP_CONSTRUCTOR}


{$ifndef FPC_SYSTEM_HAS_FPC_HELP_DESTRUCTOR}
{ Note: _self will not be reset, the compiler has to generate the reset }
procedure fpc_help_destructor(_self,_vmt:pointer;vmt_pos:cardinal);[public,alias:'FPC_HELP_DESTRUCTOR'];  compilerproc;
begin
   { already released? }
   if (_self=nil) or
      (_vmt<>pointer(-1)) or
      (ppointer(_self+vmt_pos)^=nil) then
     exit;
   if (pobjectvmt(ppointer(_self+vmt_pos)^)^.size=0) or
      (pobjectvmt(ppointer(_self+vmt_pos)^)^.size+pobjectvmt(ppointer(_self+vmt_pos)^)^.msize<>0) then
     HandleErrorAddrFrameInd(210,get_pc_addr,get_frame);
   { reset vmt to nil for protection }
   ppointer(_self+vmt_pos)^:=nil;
   freemem(_self);
end;
{$endif FPC_SYSTEM_HAS_FPC_HELP_DESTRUCTOR}


{$ifndef FPC_SYSTEM_HAS_FPC_HELP_FAIL}
{ Note: _self will not be reset, the compiler has to generate the reset }
procedure fpc_help_fail(_self:pointer;var _vmt:pointer;vmt_pos:cardinal);[public,alias:'FPC_HELP_FAIL'];compilerproc;
begin
   if (_self=nil) or (_vmt=nil) then
     exit;
   { vmt=$ffffffff when memory was allocated }
   if ptruint(_vmt)=high(ptruint) then
     begin
       if (_self=nil) or (ppointer(_self+vmt_pos)^=nil) then
         HandleError(210)
       else
         begin
           ppointer(_self+vmt_pos)^:=nil;
           freemem(_self);
           { reset _vmt to nil so it will not be freed a
             second time }
           _vmt:=nil;
         end;
     end
   else
     ppointer(_self+vmt_pos)^:=nil;
end;
{$endif FPC_SYSTEM_HAS_FPC_HELP_FAIL}

{$ifndef FPC_SYSTEM_HAS_FPC_CHECK_OBJECT}
procedure fpc_check_object(_vmt : pointer); [public,alias:'FPC_CHECK_OBJECT'];  compilerproc;
begin
  if (_vmt=nil) or
     (pobjectvmt(_vmt)^.size=0) or
     (pobjectvmt(_vmt)^.size+pobjectvmt(_vmt)^.msize<>0) then
    HandleErrorAddrFrameInd(210,get_pc_addr,get_frame);
end;

{$endif ndef FPC_SYSTEM_HAS_FPC_CHECK_OBJECT}


{$ifndef FPC_SYSTEM_HAS_FPC_CHECK_OBJECT_EXT}
{ checks for a correct vmt pointer }
{ deeper check to see if the current object is }
{ really related to the true }
procedure fpc_check_object_ext(vmt, expvmt : pointer); [public,alias:'FPC_CHECK_OBJECT_EXT']; compilerproc;
begin
   if (vmt=nil) or
      (pobjectvmt(vmt)^.size=0) or
      (pobjectvmt(vmt)^.size+pobjectvmt(vmt)^.msize<>0) then
        HandleErrorAddrFrameInd(210,get_pc_addr,get_frame);
   while assigned(vmt) do
     if vmt=expvmt then
       exit
     else
       {$ifdef VER3_0}
       vmt:=pobjectvmt(vmt)^.parent;
       {$else VER3_0}
       if assigned(pobjectvmt(vmt)^.parent) then
         vmt:=pobjectvmt(vmt)^.parent^
       else
         vmt:=nil;
       {$endif}
   HandleErrorAddrFrameInd(219,get_pc_addr,get_frame);
end;
{$endif not FPC_SYSTEM_HAS_FPC_CHECK_OBJECT_EXT}


{$endif FPC_HAS_FEATURE_OBJECTS}

{****************************************************************************
                                 String
****************************************************************************}

{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}

procedure fpc_shortstr_to_shortstr(out res:shortstring; const sstr: shortstring);[public,alias:'FPC_SHORTSTR_TO_SHORTSTR']; compilerproc;
var
  slen : byte;
begin
  slen:=length(sstr);
  if slen>high(res) then
    slen:=high(res);
  move(sstr[0],res[0],slen+1);
  res[0]:=chr(slen);
end;

procedure fpc_shortstr_assign(len:{$ifdef cpu16}smallint{$else}longint{$endif};sstr,dstr:pointer);[public,alias:'FPC_SHORTSTR_ASSIGN']; compilerproc;
var
  slen : byte;
begin
  slen:=length(pshortstring(sstr)^);
  if slen<len then
    len:=slen;
  move(sstr^,dstr^,len+1);
  if slen>len then
    pchar(dstr)^:=chr(len);
end;

{$endif ndef FPC_SYSTEM_HAS_FPC_SHORTSTR_ASSIGN}

{$push}
{ ensure that comparing addresses of openshortstrings with regular shortstrings
  doesn't cause errors }
{$t-}

{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}
procedure fpc_shortstr_concat(var dests:shortstring;const s1,s2:shortstring);compilerproc;
var
  s1l, s2l : ObjpasInt;
begin
  s1l:=length(s1);
  s2l:=length(s2);
  if s1l+s2l>high(dests) then
    begin
      if s1l>high(dests) then
        s1l:=high(dests);
      s2l:=high(dests)-s1l;
    end;
  if @dests=@s1 then
    fpc_shortstr_shortstr_intern_charmove(s2,1,dests,s1l+1,s2l)
  else
    if @dests=@s2 then
      begin
        fpc_shortstr_shortstr_intern_charmove(dests,1,dests,s1l+1,s2l);
        fpc_shortstr_shortstr_intern_charmove(s1,1,dests,1,s1l);
      end
  else
    begin
      fpc_shortstr_shortstr_intern_charmove(s1,1,dests,1,s1l);
      fpc_shortstr_shortstr_intern_charmove(s2,1,dests,s1l+1,s2l);
    end;
  dests[0]:=chr(s1l+s2l);
end;

procedure fpc_shortstr_concat_multi(var dests:shortstring;const sarr:array of pshortstring);compilerproc;
var
  s2l : byte;
  LowStart,i,
  Len : ObjpasInt;
  needtemp : boolean;
  tmpstr  : shortstring;
  p,pdest  : pshortstring;
begin
  if high(sarr)=0 then
    begin
      DestS:='';
      exit;
    end;
  lowstart:=low(sarr);
  if Pointer(@DestS)=Pointer(sarr[lowstart]) then
    inc(lowstart);
  { Check for another reuse, then we can't use
    the append optimization and need to use a temp }
  needtemp:=false;
  for i:=lowstart to high(sarr) do
    begin
      if Pointer(@DestS)=Pointer(sarr[i]) then
        begin
          needtemp:=true;
          break;
        end;
    end;
  if needtemp then
    begin
      lowstart:=low(sarr);
      tmpstr:='';
      pdest:=@tmpstr
    end
  else
    begin
      { Start with empty DestS if we start with concatting
        the first array element }
      if lowstart=low(sarr) then
        DestS:='';
      pdest:=@DestS;
    end;
  { Concat all strings, except the string we already
    copied in DestS }
  Len:=length(pdest^);
  for i:=lowstart to high(sarr) do
    begin
      p:=sarr[i];
      if assigned(p) then
        begin
          s2l:=length(p^);
          if Len+s2l>high(dests) then
            s2l:=high(dests)-Len;
          fpc_shortstr_shortstr_intern_charmove(p^,1,pdest^,Len+1,s2l);
          inc(Len,s2l);
        end;
    end;
  pdest^[0]:=Chr(Len);
  if needtemp then
    DestS:=TmpStr;
end;
{$endif ndef FPC_SYSTEM_HAS_FPC_SHORTSTR_CONCAT}

{$pop}

{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR}
procedure fpc_shortstr_append_shortstr(var s1:shortstring;const s2:shortstring);compilerproc;
    [public,alias:'FPC_SHORTSTR_APPEND_SHORTSTR'];
var
  s1l, s2l : sizeint;
begin
  s1l:=length(s1);
  s2l:=length(s2);
  if s1l+s2l>high(s1) then
    s2l:=high(s1)-s1l;
  move(s2[1],s1[s1l+1],s2l);
  s1[0]:=chr(s1l+s2l);
end;
{$endif ndef FPC_SYSTEM_HAS_FPC_SHORTSTR_APPEND_SHORTSTR}


{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_COMPARE}
function fpc_shortstr_compare(const left,right:shortstring) : longint;[public,alias:'FPC_SHORTSTR_COMPARE']; compilerproc;
var
   s1,s2,max,i : byte;
   d : ObjpasInt;
begin
  s1:=length(left);
  s2:=length(right);
  if s1<s2 then
    max:=s1
  else
    max:=s2;
  for i:=1 to max do
    begin
     d:=byte(left[i])-byte(right[i]);
     if d>0 then
       exit(1)
     else if d<0 then
       exit(-1);
    end;
  if s1>s2 then
    exit(1)
  else if s1<s2 then
    exit(-1)
  else
    exit(0);
end;
{$endif ndef FPC_SYSTEM_HAS_FPC_SHORTSTR_COMPARE}


{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_COMPARE_EQUAL}
function fpc_shortstr_compare_equal(const left,right:shortstring): longint; [public,alias:'FPC_SHORTSTR_COMPARE_EQUAL']; compilerproc;
begin
  Result := ObjpasInt(left[0]) - ObjpasInt(right[0]);
  if Result = 0 then
    Result := CompareByte(left[1],right[1], ObjpasInt(left[0]));
end;
{$endif ndef FPC_SYSTEM_HAS_FPC_SHORTSTR_COMPARE_EQUAL}


{$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}


procedure fpc_pchar_to_shortstr(out res : shortstring;p:pchar);[public,alias:'FPC_PCHAR_TO_SHORTSTR']; compilerproc;
var
  l : ObjpasInt;
  s: shortstring;
begin
  if p=nil then
    l:=0
  else
    l:=strlen(p);
  if l>high(res) then
    l:=high(res);
  if l>0 then
    move(p^,s[1],l);
  s[0]:=chr(l);
  res:=s;
end;


{$endif ndef FPC_SYSTEM_HAS_FPC_PCHAR_TO_SHORTSTR}

{$ifndef cpujvm}

{ also define alias which can be used inside the system unit }
procedure fpc_pchar_to_shortstr(out res : shortstring;p:pchar);[external name 'FPC_PCHAR_TO_SHORTSTR'];


function strpas(p:pchar):shortstring;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    fpc_pchar_to_shortstr(result,p);
  end;

{$endif not cpujvm}


function Utf8CodePointLen(P: PAnsiChar; MaxLookAhead: SizeInt; IncludeCombiningDiacriticalMarks: Boolean): SizeInt;
  var
    bytes: sizeint;
    firstzerobit: byte;
  begin
    { see https://en.wikipedia.org/wiki/UTF-8#Description for details }

    if maxlookahead<=0 then
      begin
        { incomplete }
        result:=0;
        exit;
      end;
    { include the first byte }
    result:=1;
    { multiple byte utf-8 code point? }
    if p[0]>#127 then
      begin
        { bsr searches for the leftmost 1 bit. We are interested in the
          leftmost 0 bit, so first invert the value
        }
        firstzerobit:=bsrbyte(not(byte(p[0])));
        { if there is no zero bit or the first zero bit is the rightmost bit
          (bit 0), this is an invalid UTF-8 byte ($ff cannot appear in an
          UTF-8-encoded string, and in the worst case bit 1 has to be zero)
          Additionally, 5-byte UTF-8 sequences don't exist either, so bit 1
          cannot be the first zero-bit either. And bits 6 and 7 can't be 0
          either in the first byte.
        }
        if (firstzerobit<=1) or (firstzerobit>=6)  then
          begin
            result:=-result;
            exit;
          end;
        { the number of bytes belonging to this code point is
          7-(pos first 0-bit). Subtract 1 since we're already at the first
          byte. All subsequent bytes of the same sequence must have their
          highest bit set and the next one unset. We stop when we detect an
          invalid sequence.
        }
        bytes:=6-firstzerobit;
        while (result<maxlookahead) and
              (bytes>0) and
              ((ord(p[result]) and %11000000)=%10000000) do
          begin
            inc(result);
            dec(bytes);
          end;
        { stopped because of invalid/incomplete sequence -> exit }
        if bytes<>0 then
          begin
            if result>=maxlookahead then
              result:=0
            else
              result:=-result;
            exit;
          end;
      end;
    if includecombiningdiacriticalmarks then
      begin
        { combining diacritical marks?
            1) U+0300 - U+036F in UTF-8 = %11001100 10000000 - %11001101 10101111
            2) U+1AB0 - U+1AFF in UTF-8 = %11100001 10101010 10110000 - %11100001 10101011 10111111
            3) U+1DC0 - U+1DFF in UTF-8 = %11100001 10110111 10000000 - %11100001 10110111 10111111
            4) U+20D0 - U+20FF in UTF-8 = %11100010 10000011 10010000 - %11100010 10000011 10111111
            5) U+FE20 - U+FE2F in UTF-8 = %11101111 10111000 10100000 - %11101111 10111000 10101111
        }
        repeat
          bytes:=result;
          if result+1<maxlookahead then
            begin
              { case 1) }
              if ((ord(p[result]) and %11001100=%11001100)) and
                  (ord(p[result+1])>=%10000000) and
                  (ord(p[result+1])<=%10101111) then
                inc(result,2)
                  { case 2), 3), 4), 5) }
              else if (result+2<maxlookahead) and
                 (ord(p[result])>=%11100001) then
                begin
                     { case 2) }
                  if ((ord(p[result])=%11100001) and
                      (ord(p[result+1])=%10101010) and
                      (ord(p[result+2])>=%10110000) and
                      (ord(p[result+2])<=%10111111)) or
                     { case 3) }
                     ((ord(p[result])=%11100001) and
                      (ord(p[result+1])=%10110111) and
                      (ord(p[result+2])>=%10000000) and
                      (ord(p[result+2])<=%10111111)) or
                     { case 4) }
                     ((ord(p[result])=%11100010) and
                      (ord(p[result+1])=%10000011) and
                      (ord(p[result+2])>=%10010000) and
                      (ord(p[result+2])<=%10111111)) or
                     { case 5) }
                     ((ord(p[result])=%11101111) and
                      (ord(p[result+1])=%10111000) and
                      (ord(p[result+2])>=%10100000) and
                      (ord(p[result+2])<=%10101111)) then
                    inc(result,3);
                end;
            end;
        until bytes=result;
        { is there an incomplete diacritical mark? (invalid makes little sense:
          either a sequence is a combining diacritical mark, or it's not ; if
          it's invalid, it may also not have been a combining diacritical mark)
        }
        if result<maxlookahead then
          begin
               { case 1) }
            if (((ord(p[result]) and %11001100=%11001100)) and
                (result+1>=maxlookahead)) or
               { case 2) and 3)}
               ((ord(p[result])=%11100001) and
                ((result+1>=maxlookahead) or
                 (((ord(p[result+1])=%10101010) or
                   (ord(p[result+1])=%10110111)) and
                  (result+2>=maxlookahead)))) or
               { case 4 }
               ((ord(p[result])=%11100010) and
                ((result+1>=maxlookahead) or
                 ((ord(p[result+1])=%10000011) and
                  (result+2>=maxlookahead)))) or
               { case 5 }
               ((ord(p[result])=%11101111) and
                ((result+1>=maxlookahead) or
                 ((ord(p[result+1])=%10111000) and
                  (result+2>=maxlookahead)))) then
              begin
                result:=0;
                exit;
              end;
          end;
      end;
  end;

{$ifndef FPC_SYSTEM_HAS_FPC_CHARARRAY_TO_SHORTSTR}

procedure fpc_chararray_to_shortstr(out res : shortstring;const arr: array of char; zerobased: boolean = true);[public,alias:'FPC_CHARARRAY_TO_SHORTSTR']; compilerproc;
var
 l: ObjpasInt;
 index: ObjpasInt;
 len: byte;
begin
  l:=high(arr)+1;
  if l>=high(res)+1 then
    l:=high(res)
  else if l<0 then
    l:=0;
  if zerobased then
    begin
      index:=IndexByte(arr[0],l,0);
      if index<0 then
        len:=l
      else
        len:=index;
    end
  else
    len:=l;
  move(arr[0],res[1],len);
  res[0]:=chr(len);
end;

{$endif ndef FPC_SYSTEM_HAS_FPC_CHARARRAY_TO_SHORTSTR}


{$ifndef FPC_SYSTEM_HAS_FPC_SHORTSTR_TO_CHARARRAY}

procedure fpc_shortstr_to_chararray(out res: array of char; const src: ShortString); compilerproc;
var
  len: ObjpasInt;
begin
  len := length(src);
  if len > length(res) then
    len := length(res);
{$push}{$r-}
  { make sure we don't access char 1 if length is 0 (JM) }
  if len > 0 then
    move(src[1],res[0],len);
  fillchar(res[len],length(res)-len,0);
{$pop}
end;

{$endif FPC_SYSTEM_HAS_FPC_SHORTSTR_TO_CHARARRAY}

{$ifndef FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}

function fpc_pchar_length(p:pchar):sizeint;[public,alias:'FPC_PCHAR_LENGTH']; compilerproc;
begin
  if assigned(p) then
    Result:=IndexByte(p^,high(Result),0)
  else
    Result:=0;
end;

{$endif ndef FPC_SYSTEM_HAS_FPC_PCHAR_LENGTH}

{$ifndef FPC_SYSTEM_HAS_FPC_PWIDECHAR_LENGTH}

function fpc_pwidechar_length(p:pwidechar):sizeint;[public,alias:'FPC_PWIDECHAR_LENGTH']; compilerproc;
var i : sizeint;
begin
  i:=0;
  if assigned(p) then
    while p[i]<>#0 do
      inc(i);
  exit(i);
end;

{$endif ndef FPC_SYSTEM_HAS_FPC_PWIDECHAR_LENGTH}

{****************************************************************************
                       Caller/StackFrame Helpers
****************************************************************************}

{$ifndef FPC_SYSTEM_HAS_GET_FRAME}
{_$error Get_frame must be defined for each processor }
{$endif ndef FPC_SYSTEM_HAS_GET_FRAME}

{$ifndef FPC_SYSTEM_HAS_GET_CALLER_ADDR}
{_$error Get_caller_addr must be defined for each processor }
{$endif ndef FPC_SYSTEM_HAS_GET_CALLER_ADDR}

{$ifndef FPC_SYSTEM_HAS_GET_CALLER_FRAME}
{_$error Get_caller_frame must be defined for each processor }
{$endif ndef FPC_SYSTEM_HAS_GET_CALLER_FRAME}

{****************************************************************************
                                 Math
****************************************************************************}

{****************************************************************************
                          Software multiplication
****************************************************************************}
{$ifdef FPC_INCLUDE_SOFTWARE_MUL}

{$ifdef VER3_0}

{$ifndef FPC_SYSTEM_HAS_MUL_INTEGER}
    function fpc_mul_integer(f1,f2 : integer;checkoverflow : boolean) : integer;[public,alias: 'FPC_MUL_INTEGER']; compilerproc;
      var
        sign : boolean;
        q1,q2,q3 : word;
      begin
        { there's no difference between signed and unsigned multiplication,
          when the destination size is equal to the source size and overflow
          checking is off }
        if not checkoverflow then
          { word(f1)*word(f2) is coded as a call to mulword }
          fpc_mul_integer:=integer(word(f1)*word(f2))
        else
          begin
            sign:=false;
            if f1<0 then
              begin
                sign:=not(sign);
                q1:=word(-f1);
              end
            else
              q1:=f1;
            if f2<0 then
              begin
                sign:=not(sign);
                q2:=word(-f2);
              end
            else
              q2:=f2;
            { the q1*q2 is coded as call to mulword }
            q3:=q1*q2;

            if (q1 <> 0) and (q2 <>0) and
              ((q1>q3) or (q2>q3) or
              { the bit 63 can be only set if we have $8000 }
              { and sign is true                            }
              (q3 shr 15<>0) and
               ((q3<>word(word(1) shl 15)) or not(sign))
              ) then
              HandleErrorAddrFrameInd(215,get_pc_addr,get_frame);

            if sign then
              fpc_mul_integer:=-q3
            else
              fpc_mul_integer:=q3;
          end;
      end;
{$endif FPC_SYSTEM_HAS_MUL_INTEGER}


{$ifndef FPC_SYSTEM_HAS_MUL_WORD}
    function fpc_mul_word(f1,f2 : word;checkoverflow : boolean) : word;[public,alias: 'FPC_MUL_WORD']; compilerproc;
      var
        _f1,bitpos : word;
        f1overflowed : boolean;
      begin
        fpc_mul_word:=0;
        bitpos:=1;
        f1overflowed:=false;

        while f1<>0 do
          begin
            if (f2 and bitpos)<>0 then
              begin
                _f1:=fpc_mul_word;
                fpc_mul_word:=fpc_mul_word+f1;

                { if one of the operands is greater than the result an
                  overflow occurs                                      }
                if checkoverflow and (f1overflowed or ((_f1<>0) and (f1<>0) and
                  ((_f1>fpc_mul_word) or (f1>fpc_mul_word)))) then
                  HandleErrorAddrFrameInd(215,get_pc_addr,get_frame);
              end;
            { when bootstrapping, we forget about overflow checking for qword :) }
            f1overflowed:=f1overflowed or ((f1 and (1 shl 15))<>0);
            f1:=f1 shl 1;
            bitpos:=bitpos shl 1;
          end;
      end;
{$endif FPC_SYSTEM_HAS_MUL_WORD}


{$ifndef FPC_SYSTEM_HAS_MUL_LONGINT}
    function fpc_mul_longint(f1,f2 : longint;checkoverflow : boolean) : longint;[public,alias: 'FPC_MUL_LONGINT']; compilerproc;
      var
        sign : boolean;
        q1,q2,q3 : dword;
      begin
        { there's no difference between signed and unsigned multiplication,
          when the destination size is equal to the source size and overflow
          checking is off }
        if not checkoverflow then
          { dword(f1)*dword(f2) is coded as a call to muldword }
          fpc_mul_longint:=longint(dword(f1)*dword(f2))
        else
          begin
            sign:=false;
            if f1<0 then
              begin
                sign:=not(sign);
                q1:=dword(-f1);
              end
            else
              q1:=f1;
            if f2<0 then
              begin
                sign:=not(sign);
                q2:=dword(-f2);
              end
            else
              q2:=f2;
            { the q1*q2 is coded as call to muldword }
            q3:=q1*q2;

            if (q1 <> 0) and (q2 <>0) and
              ((q1>q3) or (q2>q3) or
              { the bit 31 can be only set if we have $8000 0000 }
              { and sign is true                                 }
              (q3 shr 15<>0) and
               ((q3<>dword(dword(1) shl 31)) or not(sign))
              ) then
              HandleErrorAddrFrameInd(215,get_pc_addr,get_frame);

            if sign then
              fpc_mul_longint:=-q3
            else
              fpc_mul_longint:=q3;
          end;
      end;
{$endif FPC_SYSTEM_HAS_MUL_INTEGER}


{$ifndef FPC_SYSTEM_HAS_MUL_DWORD}
    { multiplies two dwords
      the longbool for checkoverflow avoids a misaligned stack
    }
    function fpc_mul_dword(f1,f2 : dword;checkoverflow : boolean) : dword;[public,alias: 'FPC_MUL_DWORD']; compilerproc;
      var
        _f1,bitpos : dword;
        f1overflowed : boolean;
      begin
        fpc_mul_dword:=0;
        bitpos:=1;
        f1overflowed:=false;

        while f1<>0 do
          begin
            if (f2 and bitpos)<>0 then
              begin
                _f1:=fpc_mul_dword;
                fpc_mul_dword:=fpc_mul_dword+f1;

                { if one of the operands is greater than the result an
                  overflow occurs                                      }
                if checkoverflow and (f1overflowed or ((_f1<>0) and (f1<>0) and
                  ((_f1>fpc_mul_dword) or (f1>fpc_mul_dword)))) then
                  HandleErrorAddrFrameInd(215,get_pc_addr,get_frame);
              end;
            { when bootstrapping, we forget about overflow checking for qword :) }
            f1overflowed:=f1overflowed or ((f1 and (dword(1) shl 31))<>0);
            f1:=f1 shl 1;
            bitpos:=bitpos shl 1;
          end;
      end;
{$endif FPC_SYSTEM_HAS_MUL_DWORD}

{$else VER3_0}

{$ifndef FPC_SYSTEM_HAS_MUL_SHORTINT}
    function fpc_mul_shortint(f1,f2 : shortint) : shortint;[public,alias: 'FPC_MUL_SHORTINT']; compilerproc;
      begin
        { there's no difference between signed and unsigned multiplication,
          when the destination size is equal to the source size and overflow
          checking is off }
        { byte(f1) * byte(f2) is coded as a call to mul_byte }
        fpc_mul_shortint := shortint(byte(f1) * byte(f2));
      end;

    function fpc_mul_shortint_checkoverflow(f1,f2 : shortint) : shortint;[public,alias: 'FPC_MUL_SHORTINT_CHECKOVERFLOW']; compilerproc;
      var
        sign : boolean;
        q1,q2,q3 : byte;
      begin
        sign:=false;
        if f1 < 0 then
          begin
            sign := not(sign);
            q1 := byte(-f1);
          end
        else
          q1 := f1;
        if f2 < 0 then
          begin
            sign := not(sign);
            q2 := byte(-f2);
          end
        else
          q2 := f2;
        { the q1*q2 is coded as call to mul_byte }
{$push}
{$Q+}
        q3 := q1 * q2;
{$pop}

        if (q1 <> 0) and (q2 <> 0) and
          ((q1 > q3) or (q2 > q3) or
          { the bit 7 can be only set if we have $80 }
          { and sign is true                            }
          (q3 shr 7 <> 0) and
           ((q3 <> byte(byte(1) shl 7)) or not(sign))
          ) then
          FPC_Overflow();

        if sign then
          fpc_mul_shortint_checkoverflow := -q3
        else
          fpc_mul_shortint_checkoverflow := q3;
      end;
{$endif FPC_SYSTEM_HAS_MUL_SHORTINT}

{$ifndef FPC_SYSTEM_HAS_MUL_BYTE}
    function fpc_mul_byte(f1,f2 : byte) : byte;[public,alias: 'FPC_MUL_BYTE']; compilerproc;
      var
        v1,v2,res: byte;
      begin
        if f1<f2 then
          begin
            v1:=f1;
            v2:=f2;
          end
        else
          begin
            v1:=f2;
            v2:=f1;
          end;
        res:=0;
        while v1<>0 do
          begin
            if v1 and 1<>0 then
              inc(res,v2);
            v2:=v2 shl 1;
            v1:=v1 shr 1;
          end;
        fpc_mul_byte:=res;
      end;

    function fpc_mul_byte_checkoverflow(f1,f2 : byte) : byte;[public,alias: 'FPC_MUL_BYTE_CHECKOVERFLOW']; compilerproc;
      var
        _f1, bitpos : byte;
        f1overflowed : boolean;
      begin
        fpc_mul_byte_checkoverflow := 0;
        bitpos := 1;
        f1overflowed := false;

        while f1<>0 do
          begin
            if (f2 and bitpos) <> 0 then
              begin
                _f1 := fpc_mul_byte_checkoverflow;
                fpc_mul_byte_checkoverflow := fpc_mul_byte_checkoverflow + f1;

                { if one of the operands is greater than the result an
                  overflow occurs                                      }
                if f1overflowed or ((_f1 <> 0) and (f1 <> 0) and
                  ((_f1 > fpc_mul_byte_checkoverflow) or (f1 > fpc_mul_byte_checkoverflow))) then
                  FPC_Overflow();
              end;
            { when bootstrapping, we forget about overflow checking for qword :) }
            f1overflowed := f1overflowed or ((f1 and (1 shl 7)) <> 0);
            f1 := f1 shl 1;
            bitpos := bitpos shl 1;
          end;
      end;
{$endif FPC_SYSTEM_HAS_MUL_BYTE}

{$ifndef FPC_SYSTEM_HAS_MUL_INTEGER}
    function fpc_mul_integer(f1,f2 : integer) : integer;[public,alias: 'FPC_MUL_INTEGER']; compilerproc;
      begin
        { there's no difference between signed and unsigned multiplication,
          when the destination size is equal to the source size and overflow
          checking is off }
        { word(f1)*word(f2) is coded as a call to mulword }
        fpc_mul_integer:=integer(word(f1)*word(f2));
      end;

    function fpc_mul_integer_checkoverflow(f1,f2 : integer) : integer;[public,alias: 'FPC_MUL_INTEGER_CHECKOVERFLOW']; compilerproc;
      var
        sign : boolean;
        q1,q2,q3 : word;
      begin
        sign:=false;
        if f1<0 then
          begin
            sign:=not(sign);
            q1:=word(-f1);
          end
        else
          q1:=f1;
        if f2<0 then
          begin
            sign:=not(sign);
            q2:=word(-f2);
          end
        else
          q2:=f2;
        { the q1*q2 is coded as call to mulword }
{$push}
{$Q+}
        q3:=q1*q2;
{$pop}

        if (q1 <> 0) and (q2 <>0) and
          ((q1>q3) or (q2>q3) or
          { the bit 63 can be only set if we have $8000 }
          { and sign is true                            }
          (q3 shr 15<>0) and
           ((q3<>word(word(1) shl 15)) or not(sign))
          ) then
          FPC_Overflow();

        if sign then
          fpc_mul_integer_checkoverflow:=-q3
        else
          fpc_mul_integer_checkoverflow:=q3;
      end;
{$endif FPC_SYSTEM_HAS_MUL_INTEGER}


{$ifndef FPC_SYSTEM_HAS_MUL_WORD}
    function fpc_mul_word(f1,f2 : word) : word;[public,alias: 'FPC_MUL_WORD']; compilerproc;
      var
        v1,v2,res: word;
      begin
        if f1<f2 then
          begin
            v1:=f1;
            v2:=f2;
          end
        else
          begin
            v1:=f2;
            v2:=f1;
          end;
        res:=0;
        while v1<>0 do
          begin
            if ALUUInt(v1) and 1<>0 then
              inc(res,v2);
            v2:=v2 shl 1;
            v1:=v1 shr 1;
          end;
        fpc_mul_word:=res;
      end;

    function fpc_mul_word_checkoverflow(f1,f2 : word) : word;[public,alias: 'FPC_MUL_WORD_CHECKOVERFLOW']; compilerproc;
      var
        _f1,bitpos : word;
        f1overflowed : boolean;
      begin
        fpc_mul_word_checkoverflow:=0;
        bitpos:=1;
        f1overflowed:=false;

        while f1<>0 do
          begin
            if (f2 and bitpos)<>0 then
              begin
                _f1:=fpc_mul_word_checkoverflow;
                fpc_mul_word_checkoverflow:=fpc_mul_word_checkoverflow+f1;

                { if one of the operands is greater than the result an
                  overflow occurs                                      }
                if f1overflowed or ((_f1<>0) and (f1<>0) and
                  ((_f1>fpc_mul_word_checkoverflow) or (f1>fpc_mul_word_checkoverflow))) then
                  FPC_Overflow();
              end;
            { when bootstrapping, we forget about overflow checking for qword :) }
            f1overflowed:=f1overflowed or ((f1 and (1 shl 15))<>0);
            f1:=f1 shl 1;
            bitpos:=bitpos shl 1;
          end;
      end;
{$endif FPC_SYSTEM_HAS_MUL_WORD}


{$ifndef FPC_SYSTEM_HAS_MUL_LONGINT}
    function fpc_mul_longint(f1,f2 : longint) : longint;[public,alias: 'FPC_MUL_LONGINT']; compilerproc;
      begin
        { there's no difference between signed and unsigned multiplication,
          when the destination size is equal to the source size and overflow
          checking is off }
        { dword(f1)*dword(f2) is coded as a call to muldword }
        fpc_mul_longint:=longint(dword(f1)*dword(f2));
      end;

    function fpc_mul_longint_checkoverflow(f1,f2 : longint) : longint;[public,alias: 'FPC_MUL_LONGINT_CHECKOVERFLOW']; compilerproc;
      var
        sign : boolean;
        q1,q2,q3 : dword;
      begin
        sign:=false;
        if f1<0 then
          begin
            sign:=not(sign);
            q1:=dword(-f1);
          end
        else
          q1:=f1;
        if f2<0 then
          begin
            sign:=not(sign);
            q2:=dword(-f2);
          end
        else
          q2:=f2;
        { the q1*q2 is coded as call to muldword }
{$push}
{$Q+}
        q3:=q1*q2;
{$pop}

        if (q1 <> 0) and (q2 <>0) and
          ((q1>q3) or (q2>q3) or
          { the bit 31 can be only set if we have $8000 0000 }
          { and sign is true                                 }
          (q3 shr 31<>0) and
           ((q3<>dword(dword(1) shl 31)) or not(sign))
          ) then
          FPC_Overflow();

        if sign then
          fpc_mul_longint_checkoverflow:=-q3
        else
          fpc_mul_longint_checkoverflow:=q3;
      end;
{$endif FPC_SYSTEM_HAS_MUL_INTEGER}


{$ifndef FPC_SYSTEM_HAS_MUL_DWORD}
    function fpc_mul_dword(f1,f2 : dword) : dword;[public,alias: 'FPC_MUL_DWORD']; compilerproc;
      var
        v1,v2,res: dword;
      begin
        if f1<f2 then
          begin
            v1:=f1;
            v2:=f2;
          end
        else
          begin
            v1:=f2;
            v2:=f1;
          end;
        res:=0;
        while v1<>0 do
          begin
            if ALUUInt(v1) and 1<>0 then
              inc(res,v2);
            v2:=v2 shl 1;
            v1:=v1 shr 1;
          end;
        fpc_mul_dword:=res;
      end;

    function fpc_mul_dword_checkoverflow(f1,f2 : dword) : dword;[public,alias: 'FPC_MUL_DWORD_CHECKOVERFLOW']; compilerproc;
      var
        _f1,bitpos : dword;
        f1overflowed : boolean;
      begin
        fpc_mul_dword_checkoverflow:=0;
        bitpos:=1;
        f1overflowed:=false;

        while f1<>0 do
          begin
            if (f2 and bitpos)<>0 then
              begin
                _f1:=fpc_mul_dword_checkoverflow;
                fpc_mul_dword_checkoverflow:=fpc_mul_dword_checkoverflow+f1;

                { if one of the operands is greater than the result an
                  overflow occurs                                      }
                if f1overflowed or ((_f1<>0) and (f1<>0) and
                  ((_f1>fpc_mul_dword_checkoverflow) or (f1>fpc_mul_dword_checkoverflow))) then
                  FPC_Overflow();
              end;
            { when bootstrapping, we forget about overflow checking for qword :) }
            f1overflowed:=f1overflowed or ((f1 and (dword(1) shl 31))<>0);
            f1:=f1 shl 1;
            bitpos:=bitpos shl 1;
          end;
      end;
{$endif FPC_SYSTEM_HAS_MUL_DWORD}

{$endif VER3_0}

{$endif FPC_INCLUDE_SOFTWARE_MUL}

{****************************************************************************
                          Software longint/dword division
****************************************************************************}
{$ifdef FPC_INCLUDE_SOFTWARE_MOD_DIV}

{$ifndef FPC_SYSTEM_HAS_DIV_DWORD}
function fpc_div_dword(n,z : dword) : dword; [public,alias: 'FPC_DIV_DWORD']; compilerproc;
  var
     shift,lzz,lzn : ObjpasInt;
  begin
     result:=0;
     if n=0 then
       HandleErrorAddrFrameInd(200,get_pc_addr,get_frame);
     if z=0 then
       exit;
     lzz:=BsrDWord(z);
     lzn:=BsrDWord(n);
     { if the denominator contains less zeros
       then the numerator
       then d is greater than the n }
     if lzn>lzz then
       exit;
     shift:=lzz-lzn;
     n:=n shl shift;
     for shift:=shift downto 0 do
       begin
         if z>=n then
           begin
              z:=z-n;
              result:=result+dword(dword(1) shl shift);
           end;
         n:=n shr 1;
       end;
  end;
{$endif FPC_SYSTEM_HAS_DIV_DWORD}


{$ifndef FPC_SYSTEM_HAS_MOD_DWORD}
function fpc_mod_dword(n,z : dword) : dword; [public,alias: 'FPC_MOD_DWORD']; compilerproc;
  var
     shift,lzz,lzn : ObjpasInt;
  begin
     result:=0;
     if n=0 then
       HandleErrorAddrFrameInd(200,get_pc_addr,get_frame);
     if z=0 then
       exit;
     lzz:=BsrDWord(z);
     lzn:=BsrDWord(n);
     { if the denominator contains less zeros
       then the numerator
       then d is greater than the n }
     if lzn>lzz then
      begin
         result:=z;
         exit;
      end;
     shift:=lzz-lzn;
     n:=n shl shift;
     for shift:=shift downto 0 do
       begin
         if z>=n then
           z:=z-n;
         n:=n shr 1;
       end;
    result:=z;
  end;
{$endif FPC_SYSTEM_HAS_MOD_DWORD}


{$ifndef FPC_SYSTEM_HAS_DIV_WORD}
function fpc_div_word(n,z : word) : word; [public,alias: 'FPC_DIV_WORD']; compilerproc;
  var
     shift,lzz,lzn : Byte;
  begin
     result:=0;
     if n=0 then
       HandleErrorAddrFrameInd(200,get_pc_addr,get_frame);
     if z=0 then
       exit;
     lzz:=BsrWord(z);
     lzn:=BsrWord(n);
     { if the denominator contains less zeros
       then the numerator
       then d is greater than the n }
     if lzn>lzz then
       exit;
     shift:=lzz-lzn;
     n:=n shl shift;
     for shift:=shift downto 0 do
       begin
         if z>=n then
           begin
              z:=z-n;
              result:=result+word(word(1) shl shift);
           end;
         n:=n shr 1;
       end;
  end;
{$endif FPC_SYSTEM_HAS_DIV_WORD}


{$ifndef FPC_SYSTEM_HAS_MOD_WORD}
function fpc_mod_word(n,z : word) : word; [public,alias: 'FPC_MOD_WORD']; compilerproc;
  var
     shift,lzz,lzn : Byte;
  begin
     result:=0;
     if n=0 then
       HandleErrorAddrFrameInd(200,get_pc_addr,get_frame);
     if z=0 then
       exit;
     lzz:=BsrWord(z);
     lzn:=BsrWord(n);
     { if the denominator contains less zeros
       then the numerator
       then d is greater than the n }
     if lzn>lzz then
      begin
         result:=z;
         exit;
      end;
     shift:=lzz-lzn;
     n:=n shl shift;
     for shift:=shift downto 0 do
       begin
         if z>=n then
           z:=z-n;
         n:=n shr 1;
       end;
    result:=z;
  end;
{$endif FPC_SYSTEM_HAS_MOD_WORD}


{$ifndef FPC_SYSTEM_HAS_DIV_BYTE}
function fpc_div_byte(n,z : byte) : byte; [public,alias: 'FPC_DIV_BYTE']; compilerproc;
  var
     shift,lzz,lzn : Byte;
  begin
     result:=0;
     if n=0 then
       HandleErrorAddrFrameInd(200,get_pc_addr,get_frame);
     if z=0 then
       exit;
     lzz:=BsrByte(z);
     lzn:=BsrByte(n);
     { if the denominator contains less zeros
       then the numerator
       then d is greater than the n }
     if lzn>lzz then
       exit;
     shift:=lzz-lzn;
     n:=n shl shift;
     for shift:=shift downto 0 do
       begin
         if z>=n then
           begin
              z:=z-n;
              result:=result+byte(byte(1) shl shift);
           end;
         n:=n shr 1;
       end;
  end;
{$endif FPC_SYSTEM_HAS_DIV_BYTE}


{$ifndef FPC_SYSTEM_HAS_MOD_BYTE}
function fpc_mod_byte(n,z : byte) : byte; [public,alias: 'FPC_MOD_BYTE']; compilerproc;
  var
     shift,lzz,lzn : Byte;
  begin
     result:=0;
     if n=0 then
       HandleErrorAddrFrameInd(200,get_pc_addr,get_frame);
     if z=0 then
       exit;
     lzz:=BsrByte(z);
     lzn:=BsrByte(n);
     { if the denominator contains less zeros
       then the numerator
       then d is greater than the n }
     if lzn>lzz then
      begin
         result:=z;
         exit;
      end;
     shift:=lzz-lzn;
     n:=n shl shift;
     for shift:=shift downto 0 do
       begin
         if z>=n then
           z:=z-n;
         n:=n shr 1;
       end;
    result:=z;
  end;
{$endif FPC_SYSTEM_HAS_MOD_BYTE}


{$ifndef FPC_SYSTEM_HAS_DIV_LONGINT}
function fpc_div_longint(n,z : longint) : longint; [public,alias: 'FPC_DIV_LONGINT']; compilerproc;
  var
     sign : boolean;
     d1,d2 : dword;
  begin
     if n=0 then
       HandleErrorAddrFrameInd(200,get_pc_addr,get_frame);
     sign:=false;
     if z<0 then
       begin
          sign:=not(sign);
          d1:=dword(-z);
       end
     else
       d1:=z;
     if n<0 then
       begin
          sign:=not(sign);
          d2:=dword(-n);
       end
     else
       d2:=n;

     { the div is coded by the compiler as call to divdword }
     if sign then
       result:=-(d1 div d2)
     else
       result:=d1 div d2;
  end;
{$endif FPC_SYSTEM_HAS_DIV_LONGINT}


{$ifndef FPC_SYSTEM_HAS_MOD_LONGINT}
function fpc_mod_longint(n,z : longint) : longint; [public,alias: 'FPC_MOD_LONGINT']; compilerproc;
  var
     signed : boolean;
     r,nq,zq : dword;
  begin
     if n=0 then
       HandleErrorAddrFrameInd(200,get_pc_addr,get_frame);
     nq:=abs(n);

     if z<0 then
       begin
          zq:=dword(-z);
          signed:=true;
       end
     else
       begin
         zq:=z;
         signed:=false;
       end;

     r:=zq mod nq;
     if signed then
       result:=-longint(r)
     else
       result:=r;
  end;
{$endif FPC_SYSTEM_HAS_MOD_LONGINT}


{$ifndef FPC_SYSTEM_HAS_DIV_SMALLINT}
function fpc_div_smallint(n,z : smallint) : smallint; [public,alias: 'FPC_DIV_SMALLINT']; compilerproc;
  var
     sign : boolean;
     w1,w2 : word;
  begin
     if n=0 then
       HandleErrorAddrFrameInd(200,get_pc_addr,get_frame);
     sign:=false;
     if z<0 then
       begin
          sign:=not(sign);
          w1:=word(-z);
       end
     else
       w1:=z;
     if n<0 then
       begin
          sign:=not(sign);
          w2:=word(-n);
       end
     else
       w2:=n;

     { the div is coded by the compiler as call to divdword }
     if sign then
       result:=-(w1 div w2)
     else
       result:=w1 div w2;
  end;
{$endif FPC_SYSTEM_HAS_DIV_SMALLINT}


{$ifndef FPC_SYSTEM_HAS_MOD_SMALLINT}
function fpc_mod_smallint(n,z : smallint) : smallint; [public,alias: 'FPC_MOD_SMALLINT']; compilerproc;
  var
     signed : boolean;
     r,nq,zq : word;
  begin
     if n=0 then
       HandleErrorAddrFrameInd(200,get_pc_addr,get_frame);
     nq:=abs(n);

     if z<0 then
       begin
          zq:=word(-z);
          signed:=true;
       end
     else
       begin
         zq:=z;
         signed:=false;
       end;

     r:=zq mod nq;
     if signed then
       result:=-smallint(r)
     else
       result:=r;
  end;
{$endif FPC_SYSTEM_HAS_MOD_SMALLINT}


{$ifndef FPC_SYSTEM_HAS_DIV_SHORTINT}
function fpc_div_shortint(n,z : shortint) : shortint; [public,alias: 'FPC_DIV_SHORTINT']; compilerproc;
  var
     sign : boolean;
     b1,b2 : byte;
  begin
     if n=0 then
       HandleErrorAddrFrameInd(200,get_pc_addr,get_frame);
     sign:=false;
     if z<0 then
       begin
          sign:=not(sign);
          b1:=byte(-z);
       end
     else
       b1:=z;
     if n<0 then
       begin
          sign:=not(sign);
          b2:=byte(-n);
       end
     else
       b2:=n;

     { the div is coded by the compiler as call to divdword }
     if sign then
       result:=-(b1 div b2)
     else
       result:=b1 div b2;
  end;
{$endif FPC_SYSTEM_HAS_DIV_SHORTINT}


{$ifndef FPC_SYSTEM_HAS_MOD_SHORTINT}
function fpc_mod_shortint(n,z : shortint) : shortint; [public,alias: 'FPC_MOD_SHORTINT']; compilerproc;
  var
     signed : boolean;
     r,nq,zq : byte;
  begin
     if n=0 then
       HandleErrorAddrFrameInd(200,get_pc_addr,get_frame);
     nq:=abs(n);

     if z<0 then
       begin
          zq:=byte(-z);
          signed:=true;
       end
     else
       begin
         zq:=z;
         signed:=false;
       end;

     r:=zq mod nq;
     if signed then
       result:=-shortint(r)
     else
       result:=r;
  end;
{$endif FPC_SYSTEM_HAS_MOD_SHORTINT}

{$endif FPC_INCLUDE_SOFTWARE_MOD_DIV}

{****************************************************************************}

{$if defined(CPUINT8)}
{$ifndef FPC_SYSTEM_HAS_ABS_SHORTINT}
function abs(l:shortint):shortint;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
   if l<0 then
     abs:=-l
   else
     abs:=l;
end;
{$endif not FPC_SYSTEM_HAS_ABS_SMALLINT}
{$endif CPUINT8}

{$if defined(CPUINT16) or defined(CPUINT8)}
{$ifndef FPC_SYSTEM_HAS_ABS_SMALLINT}
function abs(l:smallint):smallint;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
   if l<0 then
     abs:=-l
   else
     abs:=l;
end;
{$endif not FPC_SYSTEM_HAS_ABS_SMALLINT}
{$endif CPUINT16 or CPUINT8}

{$ifndef FPC_SYSTEM_HAS_ABS_LONGINT}
{ This is only needed to bootstrap on SPARC targets
  (MIPS and m68k too, but they have no releases, so bootstrapping is not an issue) }
function abs(l:longint):longint;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
   if l<0 then
     abs:=-l
   else
     abs:=l;
end;

{$endif not FPC_SYSTEM_HAS_ABS_LONGINT}

{$if defined(CPUINT8)}
{$ifndef FPC_SYSTEM_HAS_ODD_SHORTINT}
function odd(l:shortint):Boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
   odd:=boolean(l and 1);
end;
{$endif ndef FPC_SYSTEM_HAS_ODD_SHORTINT}
{$ifndef FPC_SYSTEM_HAS_ODD_BYTE}
function odd(l:byte):Boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
   odd:=boolean(l and 1);
end;
{$endif ndef FPC_SYSTEM_HAS_ODD_BYTE}
{$endif CPUINT8}

{$if defined(CPUINT16) or defined(CPUINT8)}
{$ifndef FPC_SYSTEM_HAS_ODD_SMALLINT}
function odd(l:smallint):Boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
   odd:=boolean(l and 1);
end;
{$endif ndef FPC_SYSTEM_HAS_ODD_SMALLINT}
{$ifndef FPC_SYSTEM_HAS_ODD_WORD}
function odd(l:word):Boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
   odd:=boolean(l and 1);
end;
{$endif ndef FPC_SYSTEM_HAS_ODD_WORD}
{$endif CPUINT16 or CPUINT8}

{$ifndef FPC_SYSTEM_HAS_ODD_LONGINT}

function odd(l:longint):boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
   odd:=boolean(l and 1);
end;

{$endif ndef FPC_SYSTEM_HAS_ODD_LONGINT}

{$ifndef FPC_SYSTEM_HAS_ODD_LONGWORD}

function odd(l:longword):boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
   odd:=boolean(l and 1);
end;

{$endif ndef FPC_SYSTEM_HAS_ODD_LONGWORD}


{$ifndef FPC_SYSTEM_HAS_ODD_INT64}

function odd(l:int64):boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
   odd:=boolean(longint(l) and 1);
end;

{$endif ndef FPC_SYSTEM_HAS_ODD_INT64}

{$ifndef FPC_SYSTEM_HAS_ODD_QWORD}

function odd(l:qword):boolean;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
   odd:=boolean(longint(l) and 1);
end;

{$endif ndef FPC_SYSTEM_HAS_ODD_QWORD}

{$if defined(CPUINT8)}
{$ifndef FPC_SYSTEM_HAS_SQR_SHORTINT}
function sqr(l:shortint):shortint;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
   sqr:=l*l;
end;
{$endif ndef FPC_SYSTEM_HAS_SQR_SHORTINT}
{$endif CPUINT8}

{$if defined(CPUINT16) or defined(CPUINT8)}
{$ifndef FPC_SYSTEM_HAS_SQR_SMALLINT}
function sqr(l:smallint):smallint;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
   sqr:=l*l;
end;
{$endif ndef FPC_SYSTEM_HAS_SQR_SMALLINT}
{$endif CPUINT16 or CPUINT8}

{$ifndef FPC_SYSTEM_HAS_SQR_LONGINT}

function sqr(l:longint):longint;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
   sqr:=l*l;
end;

{$endif ndef FPC_SYSTEM_HAS_SQR_LONGINT}


{$ifndef FPC_SYSTEM_HAS_ABS_INT64}

function abs(l: Int64): Int64;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
  if l < 0 then
    abs := -l
  else
    abs := l;
end;

{$endif ndef FPC_SYSTEM_HAS_ABS_INT64}


{$ifndef FPC_SYSTEM_HAS_SQR_INT64}

function sqr(l: Int64): Int64;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
  sqr := l*l;
end;

{$endif ndef FPC_SYSTEM_HAS_SQR_INT64}


{$ifndef FPC_SYSTEM_HAS_SQR_QWORD}

function sqr(l: QWord): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
  sqr := l*l;
end;

{$endif ndef FPC_SYSTEM_HAS_SQR_INT64}

{$ifdef CPU16}
{$ifndef FPC_SYSTEM_HAS_DECLOCKED_SMALLINT}
function declocked(var l:smallint):boolean;
  begin
    Dec(l);
    declocked:=(l=0);
  end;
{$endif FPC_SYSTEM_HAS_DECLOCKED_SMALLINT}
{$endif CPU16}

{$ifndef FPC_SYSTEM_HAS_DECLOCKED_LONGINT}
function declocked(var l:longint):boolean;
  begin
    Dec(l);
    declocked:=(l=0);
  end;
{$endif FPC_SYSTEM_HAS_DECLOCKED_LONGINT}


{$ifndef FPC_SYSTEM_HAS_DECLOCKED_INT64}
function declocked(var l:int64):boolean;
  begin
    Dec(l);
    declocked:=(l=0);
  end;
{$endif FPC_SYSTEM_HAS_DECLOCKED_INT64}


{$ifdef CPU16}
{$ifndef FPC_SYSTEM_HAS_INCLOCKED_SMALLINT}
procedure inclocked(var l:smallint);
  begin
    Inc(l);
  end;
{$endif FPC_SYSTEM_HAS_INCLOCKED_SMALLINT}
{$endif CPU16}

{$ifndef FPC_SYSTEM_HAS_INCLOCKED_LONGINT}
procedure inclocked(var l:longint);
  begin
    Inc(l);
  end;
{$endif FPC_SYSTEM_HAS_INCLOCKED_LONGINT}


{$ifndef FPC_SYSTEM_HAS_INCLOCKED_INT64}
procedure inclocked(var l:int64);
  begin
    Inc(l);
  end;
{$endif FPC_SYSTEM_HAS_INCLOCKED_INT64}


{$ifndef FPC_SYSTEM_HAS_SPTR}
{_$error Sptr must be defined for each processor }
{$endif ndef FPC_SYSTEM_HAS_SPTR}

{****************************************************************************
                                 Str()
****************************************************************************}

{$ifndef FPC_SYSTEM_HAS_INT_STR_LONGINT}

procedure int_str(l:longint;out s:shortstring);
var
  m,m1 : longword;
  pcstart,
  pc2start,
  pc,pc2 : pchar;
  hs : string[32];
  overflow : longint;
begin
  pc2start:=@s[1];
  pc2:=pc2start;
  if (l<0) then
    begin
      pc2^:='-';
      inc(pc2);
      m:=longword(-l);
    end
  else
    m:=longword(l);
  pcstart:=pchar(@hs[0]);
  pc:=pcstart;
  repeat
    m1:=m div 10;
    inc(pc);
    pc^:=char(m-(m1*10)+byte('0'));
    m:=m1;
  until m=0;
  overflow:=(pc-pcstart)+(pc2-pc2start)-high(s);
  if overflow>0 then
    inc(pcstart,overflow);
  while (pc>pcstart) do
    begin
      pc2^:=pc^;
      inc(pc2);
      dec(pc);
    end;
  s[0]:=char(pc2-pc2start);
end;

{$endif ndef FPC_SYSTEM_HAS_INT_STR_LONGINT}

{$ifndef FPC_SYSTEM_HAS_INT_STR_LONGWORD}

procedure int_str_unsigned(l:longword;out s:shortstring);
var
  m1 : longword;
  pcstart,
  pc2start,
  pc,pc2 : pchar;
  hs : string[32];
  overflow : longint;
begin
  pc2start:=@s[1];
  pc2:=pc2start;
  pcstart:=pchar(@hs[0]);
  pc:=pcstart;
  repeat
    inc(pc);
    m1:=l div 10;
    pc^:=char(l-(m1*10)+byte('0'));
    l:=m1;
  until l=0;
  overflow:=(pc-pcstart)-high(s);
  if overflow>0 then
    inc(pcstart,overflow);
  while (pc>pcstart) do
    begin
      pc2^:=pc^;
      inc(pc2);
      dec(pc);
    end;
  s[0]:=char(pc2-pc2start);
end;

{$endif ndef FPC_SYSTEM_HAS_INT_STR_LONGWORD}

{$ifndef FPC_SYSTEM_HAS_INT_STR_INT64}

procedure int_str(l:int64;out s:shortstring);
{$ifdef EXCLUDE_COMPLEX_PROCS}
begin
  runerror(217);
end;
{$else EXCLUDE_COMPLEX_PROCS}
var
  m,m1 : qword;
  pcstart,
  pc2start,
  pc,pc2 : pchar;
  hs : string[32];
  overflow : longint;
begin
  pc2start:=@s[1];
  pc2:=pc2start;
  if (l<0) then
    begin
      pc2^:='-';
      inc(pc2);
      m:=qword(-l);
    end
  else
    m:=qword(l);
  pcstart:=pchar(@hs[0]);
  pc:=pcstart;
  repeat
    m1:=m div 10;
    inc(pc);
    pc^:=char(m-(m1*10)+byte('0'));
    m:=m1;
  until m=0;
  overflow:=(pc-pcstart)+(pc2-pc2start)-high(s);
  if overflow>0 then
    inc(pcstart,overflow);
  while (pc>pcstart) do
    begin
      pc2^:=pc^;
      inc(pc2);
      dec(pc);
    end;
  s[0]:=char(pc2-pc2start);
end;
{$endif EXCLUDE_COMPLEX_PROCS}

{$endif ndef FPC_SYSTEM_HAS_INT_STR_INT64}

{$ifndef FPC_SYSTEM_HAS_INT_STR_QWORD}

procedure int_str_unsigned(l:qword;out s:shortstring);
{$ifdef EXCLUDE_COMPLEX_PROCS}
begin
  runerror(217);
end;
{$else EXCLUDE_COMPLEX_PROCS}
var
  m1 : qword;
  pcstart,
  pc2start,
  pc,pc2 : pchar;
  hs : string[64];
  overflow : longint;
begin
  pc2start:=@s[1];
  pc2:=pc2start;
  pcstart:=pchar(@hs[0]);
  pc:=pcstart;
  repeat
    inc(pc);
    m1:=l div 10;
    pc^:=char(l-(m1*10)+byte('0'));
    l:=m1;
  until l=0;
  overflow:=(pc-pcstart)-high(s);
  if overflow>0 then
    inc(pcstart,overflow);
  while (pc>pcstart) do
    begin
      pc2^:=pc^;
      inc(pc2);
      dec(pc);
    end;
  s[0]:=char(pc2-pc2start);
end;
{$endif EXCLUDE_COMPLEX_PROCS}

{$endif ndef FPC_SYSTEM_HAS_INT_STR_QWORD}

{$ifndef FPUNONE}
{$ifndef FPC_SYSTEM_HAS_SYSRESETFPU}

procedure SysResetFpu;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
  softfloat_exception_flags:=[];
end;

{$endif FPC_SYSTEM_HAS_SYSRESETFPU}

{$ifndef FPC_SYSTEM_HAS_SYSINITFPU}

procedure SysInitFpu;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
  softfloat_exception_mask:=[float_flag_underflow,float_flag_inexact,float_flag_denormal];
end;

{$endif FPC_SYSTEM_HAS_SYSINITFPU}
{$endif}

{$ifndef FPC_SYSTEM_HAS_SWAPENDIAN}
function SwapEndian(const AValue: SmallInt): SmallInt;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    { the extra Word type cast is necessary because the "AValue shr 8" }
    { is turned into "longint(AValue) shr 8", so if AValue < 0 then    }
    { the sign bits from the upper 16 bits are shifted in rather than  }
    { zeroes.                                                          }
    Result := SmallInt(((Word(AValue) shr 8) or (Word(AValue) shl 8)) and $ffff);
  end;

{$ifndef cpujvm}
function SwapEndian(const AValue: Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    Result := ((AValue shr 8) or (AValue shl 8)) and $ffff;
  end;
{$endif}

function SwapEndian(const AValue: LongInt): LongInt;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    Result := ((AValue shl 8) and $FF00FF00) or ((AValue shr 8) and $00FF00FF);
    Result := (Result shl 16) or (Result shr 16);
  end;

{$ifndef cpujvm}
function SwapEndian(const AValue: DWord): DWord;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    Result := ((AValue shl 8) and $FF00FF00) or ((AValue shr 8) and $00FF00FF);
    Result := (Result shl 16) or (Result shr 16);
  end;
{$endif}

function SwapEndian(const AValue: Int64): Int64;
  begin
    Result := ((AValue shl 8) and $FF00FF00FF00FF00) or
            ((AValue shr 8) and $00FF00FF00FF00FF);
    Result := ((Result shl 16) and $FFFF0000FFFF0000) or
            ((Result shr 16) and $0000FFFF0000FFFF);
    Result := (Result shl 32) or ((Result shr 32));
  end;

{$ifndef cpujvm}
function SwapEndian(const AValue: QWord): QWord;
  begin
    Result := ((AValue shl 8) and $FF00FF00FF00FF00) or
            ((AValue shr 8) and $00FF00FF00FF00FF);
    Result := ((Result shl 16) and $FFFF0000FFFF0000) or
            ((Result shr 16) and $0000FFFF0000FFFF);
    Result := (Result shl 32) or ((Result shr 32));
  end;
{$endif}
{$endif FPC_SYSTEM_HAS_SWAPENDIAN}

function BEtoN(const AValue: SmallInt): SmallInt;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    {$IFDEF ENDIAN_BIG}
      Result := AValue;
    {$ELSE}
      Result := SwapEndian(AValue);
    {$ENDIF}
  end;


{$ifndef cpujvm}
function BEtoN(const AValue: Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    {$IFDEF ENDIAN_BIG}
      Result := AValue;
    {$ELSE}
      Result := SwapEndian(AValue);
    {$ENDIF}
  end;
{$endif not cpujvm}


function BEtoN(const AValue: LongInt): LongInt;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    {$IFDEF ENDIAN_BIG}
      Result := AValue;
    {$ELSE}
      Result := SwapEndian(AValue);
    {$ENDIF}
  end;


{$ifndef cpujvm}
function BEtoN(const AValue: DWord): DWord;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    {$IFDEF ENDIAN_BIG}
      Result := AValue;
    {$ELSE}
      Result := SwapEndian(AValue);
    {$ENDIF}
  end;
{$endif not cpujvm}


function BEtoN(const AValue: Int64): Int64;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    {$IFDEF ENDIAN_BIG}
      Result := AValue;
    {$ELSE}
      Result := SwapEndian(AValue);
    {$ENDIF}
  end;


{$ifndef cpujvm}
function BEtoN(const AValue: QWord): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    {$IFDEF ENDIAN_BIG}
      Result := AValue;
    {$ELSE}
      Result := SwapEndian(AValue);
    {$ENDIF}
  end;
{$endif not cpujvm}



function LEtoN(const AValue: SmallInt): SmallInt;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    {$IFDEF ENDIAN_LITTLE}
      Result := AValue;
    {$ELSE}
      Result := SwapEndian(AValue);
    {$ENDIF}
  end;


{$ifndef cpujvm}
function LEtoN(const AValue: Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    {$IFDEF ENDIAN_LITTLE}
      Result := AValue;
    {$ELSE}
      Result := SwapEndian(AValue);
    {$ENDIF}
  end;
{$endif not cpujvm}


function LEtoN(const AValue: LongInt): LongInt;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    {$IFDEF ENDIAN_LITTLE}
      Result := AValue;
    {$ELSE}
      Result := SwapEndian(AValue);
    {$ENDIF}
  end;


{$ifndef cpujvm}
function LEtoN(const AValue: DWord): DWord;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    {$IFDEF ENDIAN_LITTLE}
      Result := AValue;
    {$ELSE}
      Result := SwapEndian(AValue);
    {$ENDIF}
  end;
{$endif not cpujvm}


function LEtoN(const AValue: Int64): Int64;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    {$IFDEF ENDIAN_LITTLE}
      Result := AValue;
    {$ELSE}
      Result := SwapEndian(AValue);
    {$ENDIF}
  end;


{$ifndef cpujvm}
function LEtoN(const AValue: QWord): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    {$IFDEF ENDIAN_LITTLE}
      Result := AValue;
    {$ELSE}
      Result := SwapEndian(AValue);
    {$ENDIF}
  end;
{$endif not cpujvm}



function NtoBE(const AValue: SmallInt): SmallInt;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    {$IFDEF ENDIAN_BIG}
      Result := AValue;
    {$ELSE}
      Result := SwapEndian(AValue);
    {$ENDIF}
  end;


{$ifndef cpujvm}
function NtoBE(const AValue: Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    {$IFDEF ENDIAN_BIG}
      Result := AValue;
    {$ELSE}
      Result := SwapEndian(AValue);
    {$ENDIF}
  end;
{$endif not cpujvm}


function NtoBE(const AValue: LongInt): LongInt;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    {$IFDEF ENDIAN_BIG}
      Result := AValue;
    {$ELSE}
      Result := SwapEndian(AValue);
    {$ENDIF}
  end;


{$ifndef cpujvm}
function NtoBE(const AValue: DWord): DWord;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    {$IFDEF ENDIAN_BIG}
      Result := AValue;
    {$ELSE}
      Result := SwapEndian(AValue);
    {$ENDIF}
  end;
{$endif not cpujvm}


function NtoBE(const AValue: Int64): Int64;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    {$IFDEF ENDIAN_BIG}
      Result := AValue;
    {$ELSE}
      Result := SwapEndian(AValue);
    {$ENDIF}
  end;


{$ifndef cpujvm}
function NtoBE(const AValue: QWord): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    {$IFDEF ENDIAN_BIG}
      Result := AValue;
    {$ELSE}
      Result := SwapEndian(AValue);
    {$ENDIF}
  end;
{$endif not cpujvm}


function NtoLE(const AValue: SmallInt): SmallInt;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    {$IFDEF ENDIAN_LITTLE}
      Result := AValue;
    {$ELSE}
      Result := SwapEndian(AValue);
    {$ENDIF}
  end;


{$ifndef cpujvm}
function NtoLE(const AValue: Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    {$IFDEF ENDIAN_LITTLE}
      Result := AValue;
    {$ELSE}
      Result := SwapEndian(AValue);
    {$ENDIF}
  end;
{$endif not cpujvm}


function NtoLE(const AValue: LongInt): LongInt;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    {$IFDEF ENDIAN_LITTLE}
      Result := AValue;
    {$ELSE}
      Result := SwapEndian(AValue);
    {$ENDIF}
  end;


{$ifndef cpujvm}
function NtoLE(const AValue: DWord): DWord;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    {$IFDEF ENDIAN_LITTLE}
      Result := AValue;
    {$ELSE}
      Result := SwapEndian(AValue);
    {$ENDIF}
  end;
{$endif not cpujvm}


function NtoLE(const AValue: Int64): Int64;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    {$IFDEF ENDIAN_LITTLE}
      Result := AValue;
    {$ELSE}
      Result := SwapEndian(AValue);
    {$ENDIF}
  end;


{$ifndef cpujvm}
function NtoLE(const AValue: QWord): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    {$IFDEF ENDIAN_LITTLE}
      Result := AValue;
    {$ELSE}
      Result := SwapEndian(AValue);
    {$ENDIF}
  end;
{$endif not cpujvm}

{$ifndef FPC_SYSTEM_HAS_MEM_BARRIER}

procedure ReadBarrier;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
end;

procedure ReadDependencyBarrier;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
end;

procedure ReadWriteBarrier;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
end;

procedure WriteBarrier;{$ifdef SYSTEMINLINE}inline;{$endif}
begin
end;

{$endif FPC_SYSTEM_HAS_MEM_BARRIER}

{$ifndef FPC_HAS_INTERNAL_ROX_BYTE}
{$ifndef FPC_SYSTEM_HAS_ROX_BYTE}

function RorByte(Const AValue : Byte): Byte;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    Result:=(AValue shr 1) or (AValue shl 7);
  end;


function RorByte(Const AValue : Byte;const Dist : Byte): Byte;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    Result:=(AValue shr (Dist and 7)) or (AValue shl (8-(Dist and 7)));
  end;


function RolByte(Const AValue : Byte): Byte;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    Result:=(AValue shl 1) or (AValue shr 7);
  end;


function RolByte(Const AValue : Byte;const Dist : Byte): Byte;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    Result:=(AValue shl (Dist and 7)) or (AValue shr (8-(Dist and 7)));
  end;

{$endif FPC_SYSTEM_HAS_ROX_BYTE}
{$endif FPC_HAS_INTERNAL_ROX_BYTE}

{$ifndef FPC_HAS_INTERNAL_ROX_WORD}
{$ifndef FPC_SYSTEM_HAS_ROX_WORD}

function RorWord(Const AValue : Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    Result:=(AValue shr 1) or (AValue shl 15);
  end;


function RorWord(Const AValue : Word;const Dist : Byte): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    Result:=(AValue shr (Dist and 15)) or (AValue shl (16-(Dist and 15)));
  end;


function RolWord(Const AValue : Word): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    Result:=(AValue shl 1) or (AValue shr 15);
  end;


function RolWord(Const AValue : Word;const Dist : Byte): Word;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    Result:=(AValue shl (Dist and 15)) or (AValue shr (16-(Dist and 15)));
  end;

{$endif FPC_SYSTEM_HAS_ROX_WORD}
{$endif FPC_HAS_INTERNAL_ROX_WORD}

{$ifndef FPC_HAS_INTERNAL_ROX_DWORD}
{$ifndef FPC_SYSTEM_HAS_ROX_DWORD}

function RorDWord(Const AValue : DWord): DWord;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    Result:=(AValue shr 1) or (AValue shl 31);
  end;


function RorDWord(Const AValue : DWord;const Dist : Byte): DWord;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    Result:=(AValue shr (Dist and 31)) or (AValue shl (32-(Dist and 31)));
  end;


function RolDWord(Const AValue : DWord): DWord;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    Result:=(AValue shl 1) or (AValue shr 31);
  end;


function RolDWord(Const AValue : DWord;const Dist : Byte): DWord;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    Result:=(AValue shl (Dist and 31)) or (AValue shr (32-(Dist and 31)));
  end;

{$endif FPC_SYSTEM_HAS_ROX_DWORD}
{$endif FPC_HAS_INTERNAL_ROX_DWORD}

{$ifndef FPC_HAS_INTERNAL_ROX_QWORD}
{$ifndef FPC_SYSTEM_HAS_ROX_QWORD}

function RorQWord(Const AValue : QWord): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    Result:=(AValue shr 1) or (AValue shl 63);
  end;


function RorQWord(Const AValue : QWord;const Dist : Byte): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    Result:=(AValue shr (Dist and 63)) or (AValue shl (64-(Dist and 63)));
  end;


function RolQWord(Const AValue : QWord): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    Result:=(AValue shl 1) or (AValue shr 63);
  end;


function RolQWord(Const AValue : QWord;const Dist : Byte): QWord;{$ifdef SYSTEMINLINE}inline;{$endif}
  begin
    Result:=(AValue shl (Dist and 63)) or (AValue shr (64-(Dist and 63)));
  end;

{$endif FPC_SYSTEM_HAS_ROX_QWORD}
{$endif FPC_HAS_INTERNAL_ROX_QWORD}

{$ifndef FPC_HAS_INTERNAL_ROX_ASSIGN_QWORD}
{$ifndef FPC_SYSTEM_HAS_ROX_ASSIGN_QWORD}
procedure fpc_ror_assign_int64(var AValue : int64;const Dist : Byte); [Public,Alias:'FPC_ROR_ASSIGN_INT64']; compilerproc;
  begin
    AValue:=(AValue shr (Dist and 63)) or (AValue shl (64-(Dist and 63)));
  end;


procedure fpc_ror_assign_qword(var AValue : QWord;const Dist : Byte); [Public,Alias:'FPC_ROR_ASSIGN_QWORD']; compilerproc;
  begin
    AValue:=(AValue shr (Dist and 63)) or (AValue shl (64-(Dist and 63)));
  end;


procedure fpc_rol_assign_int64(var AValue : int64;const Dist : Byte); [Public,Alias:'FPC_ROL_ASSIGN_INT64']; compilerproc;
  begin
    AValue:=(AValue shl (Dist and 63)) or (AValue shr (64-(Dist and 63)));
  end;


procedure fpc_rol_assign_qword(var AValue : QWord;const Dist : Byte); [Public,Alias:'FPC_ROL_ASSIGN_QWORD']; compilerproc;
  begin
    AValue:=(AValue shl (Dist and 63)) or (AValue shr (64-(Dist and 63)));
  end;
{$endif FPC_SYSTEM_HAS_ROX_ASSIGN_QWORD}
{$endif FPC_HAS_INTERNAL_ROX_ASSIGN_QWORD}

{$ifndef FPC_HAS_INTERNAL_SAR_BYTE}
{$ifndef FPC_SYSTEM_HAS_SAR_BYTE}
function SarShortint(Const AValue : Shortint;const Shift : Byte): Shortint;
  begin
    Result:=shortint(byte(byte(byte(AValue) shr (Shift and 7)) or (byte(shortint(byte(0-byte(byte(AValue) shr 7)) and byte(shortint(0-(ord((Shift and 7)<>0){ and 1}))))) shl (8-(Shift and 7)))));
  end;
{$endif FPC_HAS_INTERNAL_SAR_BYTE}
{$endif FPC_SYSTEM_HAS_SAR_BYTE}

{$ifndef FPC_HAS_INTERNAL_SAR_WORD}
{$ifndef FPC_SYSTEM_HAS_SAR_WORD}
function SarSmallint(Const AValue : Smallint;const Shift : Byte): Smallint;
  begin
    Result:=smallint(word(word(word(AValue) shr (Shift and 15)) or (word(smallint(word(0-word(word(AValue) shr 15)) and word(smallint(0-(ord((Shift and 15)<>0){ and 1}))))) shl (16-(Shift and 15)))));
  end;
{$endif FPC_HAS_INTERNAL_SAR_WORD}
{$endif FPC_SYSTEM_HAS_SAR_WORD}

{$ifndef FPC_HAS_INTERNAL_SAR_DWORD}
{$ifndef FPC_SYSTEM_HAS_SAR_DWORD}
function SarLongint(Const AValue : Longint;const Shift : Byte): Longint;
  begin
    Result:=longint(dword(dword(dword(AValue) shr (Shift and 31)) or (dword(longint(dword(0-dword(dword(AValue) shr 31)) and dword(longint(0-(ord((Shift and 31)<>0){ and 1}))))) shl (32-(Shift and 31)))));
  end;
{$endif FPC_HAS_INTERNAL_SAR_DWORD}
{$endif FPC_SYSTEM_HAS_SAR_DWORD}

{$ifndef FPC_HAS_INTERNAL_SAR_QWORD}
{$ifndef FPC_SYSTEM_HAS_SAR_QWORD}
function fpc_SarInt64(Const AValue : Int64;const Shift : Byte): Int64; [Public,Alias:'FPC_SARINT64']; compilerproc;
  begin
    Result:=int64(qword(qword(qword(AValue) shr (Shift and 63)) or (qword(int64(qword(0-qword(qword(AValue) shr 63)) and qword(int64(0-(ord((Shift and 63)<>0){ and 1}))))) shl (64-(Shift and 63)))));
  end;
{$endif FPC_HAS_INTERNAL_SAR_QWORD}
{$endif FPC_SYSTEM_HAS_SAR_QWORD}

{$ifndef FPC_HAS_INTERNAL_SAR_ASSIGN_QWORD}
{$ifndef FPC_SYSTEM_HAS_SAR_ASSIGN_QWORD}
procedure fpc_sar_assign_int64(var AValue : Int64;const Shift : Byte); [Public,Alias:'FPC_SAR_ASSIGN_INT64']; compilerproc;
  begin
    AValue:=int64(qword(qword(qword(AValue) shr (Shift and 63)) or (qword(int64(qword(0-qword(qword(AValue) shr 63)) and qword(int64(0-(ord((Shift and 63)<>0){ and 1}))))) shl (64-(Shift and 63)))));
  end;
procedure fpc_sar_assign_qword(var AValue : QWord;const Shift : Byte); [Public,Alias:'FPC_SAR_ASSIGN_QWORD']; compilerproc;
  begin
    AValue:=qword(qword(qword(qword(AValue) shr (Shift and 63)) or (qword(int64(qword(0-qword(qword(AValue) shr 63)) and qword(int64(0-(ord((Shift and 63)<>0){ and 1}))))) shl (64-(Shift and 63)))));
  end;
{$endif FPC_HAS_INTERNAL_SAR_ASSIGN_QWORD}
{$endif FPC_SYSTEM_HAS_SAR_ASSIGN_QWORD}

{$ifndef FPC_HAS_INTERNAL_BSF_BYTE}
{$ifndef FPC_SYSTEM_HAS_BSF_BYTE}
function BsfByte(Const AValue: Byte): Byte;
  const bsf8bit: array [Byte] of Byte = (
	  $ff,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,
	  5,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,
	  6,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,
	  5,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,
	  7,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,
	  5,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,
	  6,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,
	  5,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0,4,0,1,0,2,0,1,0,3,0,1,0,2,0,1,0
  );
  begin
    result:=bsf8bit[AValue];
  end;
{$endif}
{$endif}

{$ifndef FPC_HAS_INTERNAL_BSR_BYTE}
{$ifndef FPC_SYSTEM_HAS_BSR_BYTE}
function BsrByte(Const AValue: Byte): Byte;
  const bsr8bit: array [Byte] of Byte = (
    $ff,0,1,1,2,2,2,2,3,3,3,3,3,3,3,3,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,4,
	  5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,5,
	  6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,
	  6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,6,
	  7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
	  7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
	  7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,
	  7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7,7
  );
  begin
    result:=bsr8bit[AValue];
  end;
{$endif}
{$endif}

{$ifndef FPC_SYSTEM_HAS_BSF_WORD}
{$ifndef FPC_HAS_INTERNAL_BSF_WORD}
function BsfWord(Const AValue: Word): {$ifdef CPU16}byte{$else}cardinal{$endif};
  begin
    result:=ord(lo(AValue)=0)*8;
    result:=result or BsfByte(byte(AValue shr result));
  end;
{$endif}
{$endif}

{$ifndef FPC_SYSTEM_HAS_BSR_WORD}
{$ifndef FPC_HAS_INTERNAL_BSR_WORD}
function BsrWord(Const AValue: Word): {$ifdef CPU16}byte{$else}cardinal{$endif};
  begin
    result:=ord(AValue>255)*8;
    result:=result or BsrByte(byte(AValue shr result));
  end;
{$endif}
{$endif}

{$ifndef FPC_HAS_INTERNAL_BSF_DWORD}
{$ifndef FPC_SYSTEM_HAS_BSF_DWORD}
function BsfDWord(Const AValue : DWord): {$ifdef CPU16}byte{$else}cardinal{$endif};
  var
    tmp: DWord;
  begin
    result:=ord(lo(AValue)=0)*16;
    tmp:=AValue shr result;
    result:=result or (ord((tmp and $FF)=0)*8);
    tmp:=tmp shr (result and 8);
    result:=result or BsfByte(byte(tmp));
  end;
{$endif}
{$endif}

{$ifndef FPC_HAS_INTERNAL_BSR_DWORD}
{$ifndef FPC_SYSTEM_HAS_BSR_DWORD}
function BsrDWord(Const AValue : DWord): {$ifdef CPU16}byte{$else}cardinal{$endif};
  var
    tmp: DWord;
  begin
    result:=ord(AValue>$FFFF)*16;
    tmp:=AValue shr result;
    result:=result or (ord(tmp>$FF)*8);
    tmp:=tmp shr (result and 8);
    result:=result or BsrByte(byte(tmp));
  end;
{$endif}
{$endif}

{$ifndef FPC_HAS_INTERNAL_BSF_QWORD}
{$ifndef FPC_SYSTEM_HAS_BSF_QWORD}
function BsfQWord(Const AValue : QWord): {$ifdef CPU16}byte{$else}cardinal{$endif};
  var
    tmp: DWord;
  begin
    result:=0;
    tmp:=lo(AValue);
    if (tmp=0) then
      begin
        tmp:=hi(AValue);
        result:=32;
      end;
    result:=result or BsfDword(tmp);
  end;
{$endif}
{$endif}

{$ifndef FPC_HAS_INTERNAL_BSR_QWORD}
{$ifndef FPC_SYSTEM_HAS_BSR_QWORD}
function BsrQWord(Const AValue : QWord): {$ifdef CPU16}byte{$else}cardinal{$endif};
  var
    tmp: DWord;
  begin
    result:=32;
    tmp:=hi(AValue);
    if (tmp=0) then
      begin
        tmp:=lo(AValue);
        result:=0;
      end;
    result:=result or BsrDword(tmp);
  end;
{$endif}
{$endif}

const
  PopCntData : array[0..15] of byte = (0,1,1,2,1,2,2,3,1,2,2,3,2,3,3,4);

function fpc_PopCnt_byte(AValue : Byte): Byte;[Public,Alias:'FPC_POPCNT_BYTE'];compilerproc;
  begin
    Result:=PopCntData[AValue and $f]+PopCntData[(AValue shr 4) and $f];
  end;


function fpc_PopCnt_word(AValue : Word): Word;[Public,Alias:'FPC_POPCNT_WORD'];compilerproc;
  var
    i : SizeInt;
  begin
    Result:=0;
    for i:=0 to 3 do
      begin
        inc(Result,PopCntData[AValue and $f]);
        AValue:=AValue shr 4;
      end;
  end;


function fpc_PopCnt_dword(AValue : DWord): DWord;[Public,Alias:'FPC_POPCNT_DWORD'];compilerproc;
  var
    i : SizeInt;
  begin
    Result:=0;
    for i:=0 to 7 do
      begin
        inc(Result,PopCntData[AValue and $f]);
        AValue:=AValue shr 4;
      end;
  end;


{$ifndef FPC_SYSTEM_HAS_POPCNT_QWORD}
function fpc_PopCnt_qword(AValue : QWord): QWord;[Public,Alias:'FPC_POPCNT_QWORD'];compilerproc;
  begin
    Result:=PopCnt(lo(AValue))+PopCnt(hi(AValue))
  end;
{$endif}