diff options
| author | Sverker Eriksson <[email protected]> | 2017-08-30 20:55:08 +0200 |
|---|---|---|
| committer | Sverker Eriksson <[email protected]> | 2017-08-30 20:55:08 +0200 |
| commit | 7c67bbddb53c364086f66260701bc54a61c9659c (patch) | |
| tree | 92ab0d4b91d5e2f6e7a3f9d61ea25089e8a71fe0 /lib/hipe | |
| parent | 97dc5e7f396129222419811c173edc7fa767b0f8 (diff) | |
| parent | 3b7a6ffddc819bf305353a593904cea9e932e7dc (diff) | |
| download | otp-7c67bbddb53c364086f66260701bc54a61c9659c.tar.gz otp-7c67bbddb53c364086f66260701bc54a61c9659c.tar.bz2 otp-7c67bbddb53c364086f66260701bc54a61c9659c.zip | |
Merge tag 'OTP-19.0' into sverker/19/binary_to_atom-utf8-crash/ERL-474/OTP-14590
Diffstat (limited to 'lib/hipe')
359 files changed, 25660 insertions, 7192 deletions
diff --git a/lib/hipe/Makefile b/lib/hipe/Makefile index a9e24f4d17..0676484fca 100644 --- a/lib/hipe/Makefile +++ b/lib/hipe/Makefile @@ -1,18 +1,19 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2001-2012. All Rights Reserved. +# Copyright Ericsson AB 2001-2016. All Rights Reserved. # -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at # -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. # # %CopyrightEnd% # @@ -22,7 +23,7 @@ include $(ERL_TOP)/make/target.mk include $(ERL_TOP)/make/$(TARGET)/otp.mk ifdef HIPE_ENABLED -HIPE_SUBDIRS = regalloc sparc ppc x86 amd64 arm opt tools +HIPE_SUBDIRS = regalloc sparc ppc x86 amd64 arm opt tools llvm else HIPE_SUBDIRS = endif diff --git a/lib/hipe/amd64/Makefile b/lib/hipe/amd64/Makefile index 50cd024d72..8dc2af2679 100644 --- a/lib/hipe/amd64/Makefile +++ b/lib/hipe/amd64/Makefile @@ -1,18 +1,19 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2004-2012. All Rights Reserved. +# Copyright Ericsson AB 2004-2016. All Rights Reserved. # -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at # -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. # # %CopyrightEnd% # @@ -72,7 +73,7 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += -DHIPE_AMD64 +warn_exported_vars +ERL_COMPILE_FLAGS += -DHIPE_AMD64 -Werror +warn_export_vars # ---------------------------------------------------- # Targets diff --git a/lib/hipe/amd64/hipe_amd64_assemble.erl b/lib/hipe/amd64/hipe_amd64_assemble.erl index db3cfcc6bd..a7b11f7c72 100644 --- a/lib/hipe/amd64/hipe_amd64_assemble.erl +++ b/lib/hipe/amd64/hipe_amd64_assemble.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/amd64/hipe_amd64_defuse.erl b/lib/hipe/amd64/hipe_amd64_defuse.erl index c48e80f3f1..907f078f3f 100644 --- a/lib/hipe/amd64/hipe_amd64_defuse.erl +++ b/lib/hipe/amd64/hipe_amd64_defuse.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/amd64/hipe_amd64_encode.erl b/lib/hipe/amd64/hipe_amd64_encode.erl index cbdab25b25..df15732cea 100644 --- a/lib/hipe/amd64/hipe_amd64_encode.erl +++ b/lib/hipe/amd64/hipe_amd64_encode.erl @@ -1,18 +1,19 @@ %%% %%% %CopyrightBegin% %%% -%%% Copyright Ericsson AB 2004-2012. All Rights Reserved. +%%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %%% -%%% The contents of this file are subject to the Erlang Public License, -%%% Version 1.1, (the "License"); you may not use this file except in -%%% compliance with the License. You should have received a copy of the -%%% Erlang Public License along with this software. If not, it can be -%%% retrieved online at http://www.erlang.org/. -%%% -%%% Software distributed under the License is distributed on an "AS IS" -%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%%% the License for the specific language governing rights and limitations -%%% under the License. +%%% Licensed under the Apache License, Version 2.0 (the "License"); +%%% you may not use this file except in compliance with the License. +%%% You may obtain a copy of the License at +%%% +%%% http://www.apache.org/licenses/LICENSE-2.0 +%%% +%%% Unless required by applicable law or agreed to in writing, software +%%% distributed under the License is distributed on an "AS IS" BASIS, +%%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%%% See the License for the specific language governing permissions and +%%% limitations under the License. %%% %%% %CopyrightEnd% %%% diff --git a/lib/hipe/amd64/hipe_amd64_frame.erl b/lib/hipe/amd64/hipe_amd64_frame.erl index 2bc319f40f..f3bcdf302a 100644 --- a/lib/hipe/amd64/hipe_amd64_frame.erl +++ b/lib/hipe/amd64/hipe_amd64_frame.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/amd64/hipe_amd64_liveness.erl b/lib/hipe/amd64/hipe_amd64_liveness.erl index be878773cb..5cfdbb0f3e 100644 --- a/lib/hipe/amd64/hipe_amd64_liveness.erl +++ b/lib/hipe/amd64/hipe_amd64_liveness.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/amd64/hipe_amd64_main.erl b/lib/hipe/amd64/hipe_amd64_main.erl index 4de7364170..c22c6cd73b 100644 --- a/lib/hipe/amd64/hipe_amd64_main.erl +++ b/lib/hipe/amd64/hipe_amd64_main.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/amd64/hipe_amd64_pp.erl b/lib/hipe/amd64/hipe_amd64_pp.erl index 93ed7b9073..7c3ee8458a 100644 --- a/lib/hipe/amd64/hipe_amd64_pp.erl +++ b/lib/hipe/amd64/hipe_amd64_pp.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/amd64/hipe_amd64_ra.erl b/lib/hipe/amd64/hipe_amd64_ra.erl index b9ac0338f0..1d8453d54d 100644 --- a/lib/hipe/amd64/hipe_amd64_ra.erl +++ b/lib/hipe/amd64/hipe_amd64_ra.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/amd64/hipe_amd64_ra_finalise.erl b/lib/hipe/amd64/hipe_amd64_ra_finalise.erl index a6a787c340..d835c3ec14 100644 --- a/lib/hipe/amd64/hipe_amd64_ra_finalise.erl +++ b/lib/hipe/amd64/hipe_amd64_ra_finalise.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/amd64/hipe_amd64_ra_ls.erl b/lib/hipe/amd64/hipe_amd64_ra_ls.erl index 7ff2a7c082..9361b91f04 100644 --- a/lib/hipe/amd64/hipe_amd64_ra_ls.erl +++ b/lib/hipe/amd64/hipe_amd64_ra_ls.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/amd64/hipe_amd64_ra_naive.erl b/lib/hipe/amd64/hipe_amd64_ra_naive.erl index 194ea8b597..38218a65dc 100644 --- a/lib/hipe/amd64/hipe_amd64_ra_naive.erl +++ b/lib/hipe/amd64/hipe_amd64_ra_naive.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/amd64/hipe_amd64_ra_postconditions.erl b/lib/hipe/amd64/hipe_amd64_ra_postconditions.erl index ef3c284c45..2d03239ea6 100644 --- a/lib/hipe/amd64/hipe_amd64_ra_postconditions.erl +++ b/lib/hipe/amd64/hipe_amd64_ra_postconditions.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/amd64/hipe_amd64_ra_sse2_postconditions.erl b/lib/hipe/amd64/hipe_amd64_ra_sse2_postconditions.erl index 9ed3d01a56..5451f1fe7d 100644 --- a/lib/hipe/amd64/hipe_amd64_ra_sse2_postconditions.erl +++ b/lib/hipe/amd64/hipe_amd64_ra_sse2_postconditions.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/amd64/hipe_amd64_ra_x87_ls.erl b/lib/hipe/amd64/hipe_amd64_ra_x87_ls.erl index 267f3335aa..6da3f44cd3 100644 --- a/lib/hipe/amd64/hipe_amd64_ra_x87_ls.erl +++ b/lib/hipe/amd64/hipe_amd64_ra_x87_ls.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/amd64/hipe_amd64_registers.erl b/lib/hipe/amd64/hipe_amd64_registers.erl index 4c49eeb00a..780c2cc547 100644 --- a/lib/hipe/amd64/hipe_amd64_registers.erl +++ b/lib/hipe/amd64/hipe_amd64_registers.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/amd64/hipe_amd64_spill_restore.erl b/lib/hipe/amd64/hipe_amd64_spill_restore.erl index 56e3ffd24d..61e2dfa26d 100644 --- a/lib/hipe/amd64/hipe_amd64_spill_restore.erl +++ b/lib/hipe/amd64/hipe_amd64_spill_restore.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2009. All Rights Reserved. +%% Copyright Ericsson AB 2008-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/amd64/hipe_amd64_x87.erl b/lib/hipe/amd64/hipe_amd64_x87.erl index e7bf1c1866..1f42e4749d 100644 --- a/lib/hipe/amd64/hipe_amd64_x87.erl +++ b/lib/hipe/amd64/hipe_amd64_x87.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/amd64/hipe_rtl_to_amd64.erl b/lib/hipe/amd64/hipe_rtl_to_amd64.erl index 17aef0eeac..d55b5b2c22 100644 --- a/lib/hipe/amd64/hipe_rtl_to_amd64.erl +++ b/lib/hipe/amd64/hipe_rtl_to_amd64.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/arm/Makefile b/lib/hipe/arm/Makefile index 651b82f1ed..00b6732afa 100644 --- a/lib/hipe/arm/Makefile +++ b/lib/hipe/arm/Makefile @@ -1,18 +1,19 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2005-2012. All Rights Reserved. +# Copyright Ericsson AB 2005-2016. All Rights Reserved. # -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at # -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. # # %CopyrightEnd% # @@ -73,7 +74,7 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += +warn_exported_vars +ERL_COMPILE_FLAGS += -Werror +warn_export_vars # ---------------------------------------------------- # Targets diff --git a/lib/hipe/arm/hipe_arm.erl b/lib/hipe/arm/hipe_arm.erl index 391f84ca47..f34525fa3b 100644 --- a/lib/hipe/arm/hipe_arm.erl +++ b/lib/hipe/arm/hipe_arm.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/arm/hipe_arm.hrl b/lib/hipe/arm/hipe_arm.hrl index 9ee2cb3d06..558174e3fc 100644 --- a/lib/hipe/arm/hipe_arm.hrl +++ b/lib/hipe/arm/hipe_arm.hrl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/arm/hipe_arm_assemble.erl b/lib/hipe/arm/hipe_arm_assemble.erl index 2af786994e..4a245cd853 100644 --- a/lib/hipe/arm/hipe_arm_assemble.erl +++ b/lib/hipe/arm/hipe_arm_assemble.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -44,10 +45,10 @@ assemble(CompiledCode, Closures, Exports, Options) -> print("Total num bytes=~w\n", [CodeSize], Options), %% SC = hipe_pack_constants:slim_constmap(ConstMap), - DataRelocs = mk_data_relocs(RefsFromConsts, LabelMap), - SSE = slim_sorted_exportmap(ExportMap,Closures,Exports), + DataRelocs = hipe_pack_constants:mk_data_relocs(RefsFromConsts, LabelMap), + SSE = hipe_pack_constants:slim_sorted_exportmap(ExportMap,Closures,Exports), SlimRefs = hipe_pack_constants:slim_refs(AccRefs), - Bin = term_to_binary([{?VERSION_STRING(),?HIPE_SYSTEM_CRC}, + Bin = term_to_binary([{?VERSION_STRING(),?HIPE_ERTS_CHECKSUM}, ConstAlign, ConstSize, SC, DataRelocs, % nee LM, LabelMap @@ -320,7 +321,7 @@ do_pseudo_li(I, MFA, ConstMap, Address, PrevImms, PendImms) -> Atom when is_atom(Atom) -> {load_atom, Atom}; {Label,constant} -> - ConstNo = find_const({MFA,Label}, ConstMap), + ConstNo = hipe_pack_constants:find_const({MFA,Label}, ConstMap), {load_address, {constant,ConstNo}}; {Label,closure} -> {load_address, {closure,Label}}; @@ -518,37 +519,6 @@ fix_pc_refs(I, InsnAddress, FunAddress, LabelMap) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -mk_data_relocs(RefsFromConsts, LabelMap) -> - lists:flatten(mk_data_relocs(RefsFromConsts, LabelMap, [])). - -mk_data_relocs([{MFA,Labels} | Rest], LabelMap, Acc) -> - Map = [case Label of - {L,Pos} -> - Offset = find({MFA,L}, LabelMap), - {Pos,Offset}; - {sorted,Base,OrderedLabels} -> - {sorted, Base, [begin - Offset = find({MFA,L}, LabelMap), - {Order, Offset} - end - || {L,Order} <- OrderedLabels]} - end - || Label <- Labels], - %% msg("Map: ~w Map\n",[Map]), - mk_data_relocs(Rest, LabelMap, [Map,Acc]); -mk_data_relocs([],_,Acc) -> Acc. - -find({_MFA,_L} = MFAL, LabelMap) -> - gb_trees:get(MFAL, LabelMap). - -slim_sorted_exportmap([{Addr,M,F,A}|Rest], Closures, Exports) -> - IsClosure = lists:member({M,F,A}, Closures), - IsExported = is_exported(F, A, Exports), - [Addr,M,F,A,IsClosure,IsExported | slim_sorted_exportmap(Rest, Closures, Exports)]; -slim_sorted_exportmap([],_,_) -> []. - -is_exported(F, A, Exports) -> lists:member({F,A}, Exports). - %%% %%% Assembly listing support (pp_asm option). %%% @@ -594,17 +564,6 @@ fill_spaces(N) when N > 0 -> fill_spaces(0) -> []. -%%% -%%% Lookup a constant in a ConstMap. -%%% - -find_const({MFA,Label},[{pcm_entry,MFA,Label,ConstNo,_,_,_}|_]) -> - ConstNo; -find_const(N,[_|R]) -> - find_const(N,R); -find_const(C,[]) -> - ?EXIT({constant_not_found,C}). - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %%% diff --git a/lib/hipe/arm/hipe_arm_cfg.erl b/lib/hipe/arm/hipe_arm_cfg.erl index 984a3ccf9e..f2fa0a5164 100644 --- a/lib/hipe/arm/hipe_arm_cfg.erl +++ b/lib/hipe/arm/hipe_arm_cfg.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/arm/hipe_arm_defuse.erl b/lib/hipe/arm/hipe_arm_defuse.erl index 8d6efebc21..f57b0e601c 100644 --- a/lib/hipe/arm/hipe_arm_defuse.erl +++ b/lib/hipe/arm/hipe_arm_defuse.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/arm/hipe_arm_encode.erl b/lib/hipe/arm/hipe_arm_encode.erl index 19e507fdbd..9368cbf628 100644 --- a/lib/hipe/arm/hipe_arm_encode.erl +++ b/lib/hipe/arm/hipe_arm_encode.erl @@ -2,18 +2,19 @@ %%% %%% %CopyrightBegin% %%% -%%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %%% -%%% The contents of this file are subject to the Erlang Public License, -%%% Version 1.1, (the "License"); you may not use this file except in -%%% compliance with the License. You should have received a copy of the -%%% Erlang Public License along with this software. If not, it can be -%%% retrieved online at http://www.erlang.org/. -%%% -%%% Software distributed under the License is distributed on an "AS IS" -%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%%% the License for the specific language governing rights and limitations -%%% under the License. +%%% Licensed under the Apache License, Version 2.0 (the "License"); +%%% you may not use this file except in compliance with the License. +%%% You may obtain a copy of the License at +%%% +%%% http://www.apache.org/licenses/LICENSE-2.0 +%%% +%%% Unless required by applicable law or agreed to in writing, software +%%% distributed under the License is distributed on an "AS IS" BASIS, +%%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%%% See the License for the specific language governing permissions and +%%% limitations under the License. %%% %%% %CopyrightEnd% %%% diff --git a/lib/hipe/arm/hipe_arm_finalise.erl b/lib/hipe/arm/hipe_arm_finalise.erl index 38e3efd223..a4b2f9c73c 100644 --- a/lib/hipe/arm/hipe_arm_finalise.erl +++ b/lib/hipe/arm/hipe_arm_finalise.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/arm/hipe_arm_frame.erl b/lib/hipe/arm/hipe_arm_frame.erl index 316aa2ef82..e1e441a967 100644 --- a/lib/hipe/arm/hipe_arm_frame.erl +++ b/lib/hipe/arm/hipe_arm_frame.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/arm/hipe_arm_liveness_gpr.erl b/lib/hipe/arm/hipe_arm_liveness_gpr.erl index cab81c47a1..82cc5a7a67 100644 --- a/lib/hipe/arm/hipe_arm_liveness_gpr.erl +++ b/lib/hipe/arm/hipe_arm_liveness_gpr.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/arm/hipe_arm_main.erl b/lib/hipe/arm/hipe_arm_main.erl index 5243b3579e..dce1193b24 100644 --- a/lib/hipe/arm/hipe_arm_main.erl +++ b/lib/hipe/arm/hipe_arm_main.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/arm/hipe_arm_pp.erl b/lib/hipe/arm/hipe_arm_pp.erl index c4dde31188..18aca1fc6b 100644 --- a/lib/hipe/arm/hipe_arm_pp.erl +++ b/lib/hipe/arm/hipe_arm_pp.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2010. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/arm/hipe_arm_ra.erl b/lib/hipe/arm/hipe_arm_ra.erl index bdd9e228e0..2f65e864fd 100644 --- a/lib/hipe/arm/hipe_arm_ra.erl +++ b/lib/hipe/arm/hipe_arm_ra.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/arm/hipe_arm_ra_finalise.erl b/lib/hipe/arm/hipe_arm_ra_finalise.erl index 9edc362e90..4faeadcd7f 100644 --- a/lib/hipe/arm/hipe_arm_ra_finalise.erl +++ b/lib/hipe/arm/hipe_arm_ra_finalise.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/arm/hipe_arm_ra_ls.erl b/lib/hipe/arm/hipe_arm_ra_ls.erl index 53bfd5b2a3..d9a360d00c 100644 --- a/lib/hipe/arm/hipe_arm_ra_ls.erl +++ b/lib/hipe/arm/hipe_arm_ra_ls.erl @@ -2,18 +2,19 @@ %%% %%% %CopyrightBegin% %%% -%%% Copyright Ericsson AB 2006-2009. All Rights Reserved. +%%% Copyright Ericsson AB 2006-2016. All Rights Reserved. %%% -%%% The contents of this file are subject to the Erlang Public License, -%%% Version 1.1, (the "License"); you may not use this file except in -%%% compliance with the License. You should have received a copy of the -%%% Erlang Public License along with this software. If not, it can be -%%% retrieved online at http://www.erlang.org/. -%%% -%%% Software distributed under the License is distributed on an "AS IS" -%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%%% the License for the specific language governing rights and limitations -%%% under the License. +%%% Licensed under the Apache License, Version 2.0 (the "License"); +%%% you may not use this file except in compliance with the License. +%%% You may obtain a copy of the License at +%%% +%%% http://www.apache.org/licenses/LICENSE-2.0 +%%% +%%% Unless required by applicable law or agreed to in writing, software +%%% distributed under the License is distributed on an "AS IS" BASIS, +%%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%%% See the License for the specific language governing permissions and +%%% limitations under the License. %%% %%% %CopyrightEnd% %%% diff --git a/lib/hipe/arm/hipe_arm_ra_naive.erl b/lib/hipe/arm/hipe_arm_ra_naive.erl index 786895f2ca..6201269f44 100644 --- a/lib/hipe/arm/hipe_arm_ra_naive.erl +++ b/lib/hipe/arm/hipe_arm_ra_naive.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/arm/hipe_arm_ra_postconditions.erl b/lib/hipe/arm/hipe_arm_ra_postconditions.erl index 96b0d5733f..40978e65f6 100644 --- a/lib/hipe/arm/hipe_arm_ra_postconditions.erl +++ b/lib/hipe/arm/hipe_arm_ra_postconditions.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/arm/hipe_arm_registers.erl b/lib/hipe/arm/hipe_arm_registers.erl index ff6a163e9c..24cd929d41 100644 --- a/lib/hipe/arm/hipe_arm_registers.erl +++ b/lib/hipe/arm/hipe_arm_registers.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/arm/hipe_rtl_to_arm.erl b/lib/hipe/arm/hipe_rtl_to_arm.erl index a4dc5db978..ad5a559995 100644 --- a/lib/hipe/arm/hipe_rtl_to_arm.erl +++ b/lib/hipe/arm/hipe_rtl_to_arm.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/cerl/Makefile b/lib/hipe/cerl/Makefile index 506e993ff4..9f50d6bf91 100644 --- a/lib/hipe/cerl/Makefile +++ b/lib/hipe/cerl/Makefile @@ -1,18 +1,19 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2003-2012. All Rights Reserved. +# Copyright Ericsson AB 2003-2016. All Rights Reserved. # -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at # -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. # # %CopyrightEnd% # @@ -42,8 +43,8 @@ RELSYSDIR = $(RELEASE_PATH)/lib/hipe-$(VSN) # ---------------------------------------------------- # Target Specs # ---------------------------------------------------- -MODULES = cerl_cconv cerl_closurean cerl_hipeify \ - cerl_lib cerl_messagean cerl_pmatch cerl_prettypr cerl_to_icode \ +MODULES = cerl_cconv cerl_closurean cerl_hipeify cerl_lib \ + cerl_messagean cerl_pmatch cerl_prettypr cerl_to_icode \ cerl_typean erl_bif_types erl_types HRL_FILES= cerl_hipe_primops.hrl @@ -65,7 +66,7 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += +inline +warn_exported_vars +warn_unused_import +warn_missing_spec# +warn_untyped_record +ERL_COMPILE_FLAGS += +inline -Werror +warn_export_vars +warn_unused_import +warn_missing_spec #+warn_untyped_record # ---------------------------------------------------- # Targets @@ -107,7 +108,6 @@ release_spec: opt release_docs_spec: -$(EBIN)/cerl_to_icode.beam: cerl_hipe_primops.hrl ../icode/hipe_icode_primops.hrl +$(EBIN)/cerl_cconv.beam: cerl_hipe_primops.hrl $(EBIN)/cerl_hipeify.beam: cerl_hipe_primops.hrl -$(EBIN)/cerl_lambdalift.beam: cerl_hipe_primops.hrl -$(EBIN)/erl_bif_types.beam: ../icode/hipe_icode_primops.hrl +$(EBIN)/cerl_to_icode.beam: cerl_hipe_primops.hrl ../icode/hipe_icode_primops.hrl diff --git a/lib/hipe/cerl/cerl_cconv.erl b/lib/hipe/cerl/cerl_cconv.erl index cf4d317b0d..ac9d01ab0e 100644 --- a/lib/hipe/cerl/cerl_cconv.erl +++ b/lib/hipe/cerl/cerl_cconv.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2015. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -709,7 +710,7 @@ ren__new() -> ren__add(Key, Value, Ren) -> dict:store(Key, Value, Ren). -ren__map(Key, Ren) -> +ren__map(Key, Ren) -> case dict:find(Key, Ren) of {ok, Value} -> Value; @@ -721,11 +722,14 @@ ren__map(Key, Ren) -> %% --------------------------------------------------------------------- %% State --record(state, {module :: module(), function :: {atom(), arity()}, - names, refs, defs = []}). +-record(state, {module :: module(), + function :: {atom(), arity()} | 'undefined', + names = sets:new() :: sets:set(), %% XXX: refine + refs = dict:new() :: dict:dict(), %% XXX: refine + defs = []}). s__new(Module) -> - #state{module = Module, names = sets:new(), refs = dict:new()}. + #state{module = Module}. s__add_function_name(Name, S) -> S#state{names = sets:add_element(Name, S#state.names)}. diff --git a/lib/hipe/cerl/cerl_closurean.erl b/lib/hipe/cerl/cerl_closurean.erl index 021acd5b35..d37c91e5c6 100644 --- a/lib/hipe/cerl/cerl_closurean.erl +++ b/lib/hipe/cerl/cerl_closurean.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2010. All Rights Reserved. +%% Copyright Ericsson AB 2003-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -78,7 +79,8 @@ %% function; see `analyze' for details. -spec annotate(cerl:cerl()) -> - {cerl:cerl(), outlist(), dict(), escapes(), dict(), dict()}. + {cerl:cerl(), outlist(), dict:dict(), + escapes(), dict:dict(), dict:dict()}. annotate(Tree) -> {Xs, Out, Esc, Deps, Par} = analyze(Tree), @@ -206,7 +208,8 @@ append_ann(Tag, Val, []) -> %% variable labeled `escape', which will hold the set of escaped labels. %% initially it contains `top' and `external'. --spec analyze(cerl:cerl()) -> {outlist(), dict(), escapes(), dict(), dict()}. +-spec analyze(cerl:cerl()) -> + {outlist(), dict:dict(), escapes(), dict:dict(), dict:dict()}. analyze(Tree) -> %% Note that we use different name spaces for variable labels and diff --git a/lib/hipe/cerl/cerl_hipe_primops.hrl b/lib/hipe/cerl/cerl_hipe_primops.hrl index a777cd0108..3efb9a3bdd 100644 --- a/lib/hipe/cerl/cerl_hipe_primops.hrl +++ b/lib/hipe/cerl/cerl_hipe_primops.hrl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2012. All Rights Reserved. +%% Copyright Ericsson AB 2003-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/cerl/cerl_hipeify.erl b/lib/hipe/cerl/cerl_hipeify.erl index 3351be77f2..6611abd204 100644 --- a/lib/hipe/cerl/cerl_hipeify.erl +++ b/lib/hipe/cerl/cerl_hipeify.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2012. All Rights Reserved. +%% Copyright Ericsson AB 2003-2015. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -622,12 +623,12 @@ ren__map(Key, Ren) -> %% --------------------------------------------------------------------- %% State -%% pmatch = 'true' | 'false' | 'no_duplicates' | 'duplicate_all' +-type pmatch() :: 'true' | 'false' | 'no_duplicates' | 'duplicate_all'. --record(state, {module::atom(), - function::{atom(), 0..256}, - pmatch=true, - revisit = false}). +-record(state, {module :: module(), + function :: {atom(), arity()} | 'undefined', + pmatch = true :: pmatch(), + revisit = false :: boolean()}). s__new(Module) -> #state{module = Module}. diff --git a/lib/hipe/cerl/cerl_lib.erl b/lib/hipe/cerl/cerl_lib.erl index 83bb20e047..0bc77909d9 100644 --- a/lib/hipe/cerl/cerl_lib.erl +++ b/lib/hipe/cerl/cerl_lib.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/cerl/cerl_messagean.erl b/lib/hipe/cerl/cerl_messagean.erl index ca812a0f0d..7df0a245fb 100644 --- a/lib/hipe/cerl/cerl_messagean.erl +++ b/lib/hipe/cerl/cerl_messagean.erl @@ -1,18 +1,19 @@ %% ===================================================================== %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2012. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -182,7 +183,7 @@ -type label() :: integer() | 'external' | 'top'. -type ordset(X) :: [X]. % XXX: TAKE ME OUT --spec annotate(cerl:cerl()) -> {cerl:cerl(), ordset(label()), dict()}. +-spec annotate(cerl:cerl()) -> {cerl:cerl(), ordset(label()), dict:dict()}. annotate(Tree) -> {Esc0, Vars} = analyze(Tree), diff --git a/lib/hipe/cerl/cerl_pmatch.erl b/lib/hipe/cerl/cerl_pmatch.erl index 3bc93e80dd..ca27fff1dd 100644 --- a/lib/hipe/cerl/cerl_pmatch.erl +++ b/lib/hipe/cerl/cerl_pmatch.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2009. All Rights Reserved. +%% Copyright Ericsson AB 2003-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -31,7 +32,7 @@ -module(cerl_pmatch). --define(NO_UNUSED, true). +%%-define(NO_UNUSED, true). -export([clauses/2]). -ifndef(NO_UNUSED). @@ -59,6 +60,8 @@ %% @see transform/2 -ifndef(NO_UNUSED). +-spec core_transform(cerl:c_module(), [_]) -> cerl:c_module(). + core_transform(M, Opts) -> cerl:to_records(transform(cerl:from_records(M), Opts)). -endif. % NO_UNUSED @@ -76,6 +79,8 @@ core_transform(M, Opts) -> %% @see core_transform/2 -ifndef(NO_UNUSED). +-spec transform(cerl:cerl(), [_]) -> cerl:cerl(). + transform(M, _Opts) -> expr(M, env__empty()). -endif. % NO_UNUSED @@ -109,7 +114,7 @@ transform(M, _Opts) -> %% @see expr/2 %% @see transform/2 --spec clauses([cerl:cerl()], rec_env:environment()) -> +-spec clauses([cerl:cerl(),...], rec_env:environment()) -> {cerl:cerl(), [cerl:cerl()]}. clauses(Cs, Env) -> @@ -226,12 +231,9 @@ match_typegroup(T, V, Vs, Gs, Else, Env) -> Else, Env), typetest_clause(T, V, Body, Env). -match_congroup({?binary_id, Segs}, Vs, Cs, _Else, Env) -> - Ref = get_unique(), - Guard = cerl:c_primop(cerl:c_atom(set_label), [cerl:c_int(Ref)]), - NewElse = cerl:c_primop(cerl:c_atom(goto_label), [cerl:c_int(Ref)]), - Body = match(Vs, Cs, NewElse, Env), - cerl:c_clause([make_pat(?binary_id, Segs)], Guard, Body); +match_congroup({?binary_id, Segs}, Vs, Cs, Else, Env) -> + Body = match(Vs, Cs, Else, Env), + cerl:c_clause([make_pat(?binary_id, Segs)], Body); match_congroup({D, A}, Vs, Cs, Else, Env) -> Vs1 = new_vars(A, Env), @@ -406,8 +408,19 @@ make_let(Vs, A, B) -> %% @see rec_env -ifndef(NO_UNUSED). +-spec expr(cerl:cerl(), rec_env:environment()) -> cerl:cerl(). + expr(E, Env) -> case cerl:type(E) of + binary -> + Es = expr_list(cerl:binary_segments(E), Env), + cerl:update_c_binary(E, Es); + bitstr -> + V = expr(cerl:bitstr_val(E), Env), + Sz = expr(cerl:bitstr_size(E), Env), + Unit = expr(cerl:bitstr_unit(E), Env), + Type = expr(cerl:bitstr_type(E), Env), + cerl:update_c_bitstr(E, V, Sz, Unit, Type, cerl:bitstr_flags(E)); literal -> E; var -> @@ -577,16 +590,6 @@ is_simple(E) -> end. -get_unique() -> - case get(unique_label) of - undefined -> - put(unique_label, 1), - 0; - N -> - put(unique_label, N+1), - N - end. - %% --------------------------------------------------------------------- %% Abstract datatype: environment() diff --git a/lib/hipe/cerl/cerl_prettypr.erl b/lib/hipe/cerl/cerl_prettypr.erl index fba9a48cda..f0acab99e3 100644 --- a/lib/hipe/cerl/cerl_prettypr.erl +++ b/lib/hipe/cerl/cerl_prettypr.erl @@ -1,18 +1,19 @@ %% ===================================================================== %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -62,7 +63,10 @@ receive_action/1, receive_clauses/1, receive_timeout/1, seq_arg/1, seq_body/1, string_lit/1, try_arg/1, try_body/1, try_vars/1, try_evars/1, try_handler/1, - tuple_es/1, type/1, values_es/1, var_name/1]). + tuple_es/1, type/1, values_es/1, var_name/1, + map_arg/1, map_es/1, is_c_map_empty/1, + map_pair_key/1, map_pair_val/1, map_pair_op/1 + ]). -define(PAPER, 76). -define(RIBBON, 45). @@ -424,6 +428,10 @@ lay_1(Node, Ctxt) -> lay_cons(Node, Ctxt); tuple -> lay_tuple(Node, Ctxt); + map -> + lay_map(Node, Ctxt); + map_pair -> + lay_map_pair(Node, Ctxt); 'let' -> lay_let(Node, Ctxt); seq -> @@ -469,13 +477,20 @@ lay_literal(Node, Ctxt) -> %% that could represent printable characters - we %% always print an integer. text(int_lit(Node)); - V when is_binary(V) -> - lay_binary(c_binary([c_bitstr(abstract(B), - abstract(8), + V when is_bitstring(V) -> + Val = fun(I) when is_integer(I) -> I; + (B) when is_bitstring(B) -> + BZ = bit_size(B), <<BV:BZ>> = B, BV + end, + Sz = fun(I) when is_integer(I) -> 8; + (B) when is_bitstring(B) -> bit_size(B) + end, + lay_binary(c_binary([c_bitstr(abstract(Val(B)), + abstract(Sz(B)), abstract(1), abstract(integer), abstract([unsigned, big])) - || B <- binary_to_list(V)]), + || B <- bitstring_to_list(V)]), Ctxt); [] -> text("[]"); @@ -483,7 +498,9 @@ lay_literal(Node, Ctxt) -> %% `lay_cons' will check for strings. lay_cons(Node, Ctxt); V when is_tuple(V) -> - lay_tuple(Node, Ctxt) + lay_tuple(Node, Ctxt); + M when is_map(M) -> + lay_map(Node, Ctxt) end. lay_var(Node, Ctxt) -> @@ -589,6 +606,28 @@ lay_tuple(Node, Ctxt) -> Ctxt, fun lay/2)), floating(text("}")))). +lay_map(Node, Ctxt) -> + Arg = map_arg(Node), + After = case is_c_map_empty(Arg) of + true -> floating(text("}~")); + false -> + beside(floating(text(" | ")), + beside(lay(Arg,Ctxt), + floating(text("}~")))) + end, + beside(floating(text("~{")), + beside(par(seq(map_es(Node), floating(text(",")), Ctxt, fun lay/2)), + After)). + +lay_map_pair(Node, Ctxt) -> + K = map_pair_key(Node), + V = map_pair_val(Node), + OpTxt = case concrete(map_pair_op(Node)) of + assoc -> "=>"; + exact -> ":=" + end, + beside(lay(K,Ctxt),beside(floating(text(OpTxt)),lay(V,Ctxt))). + lay_let(Node, Ctxt) -> V = lay_value_list(let_vars(Node), Ctxt), D1 = par([follow(text("let"), diff --git a/lib/hipe/cerl/cerl_to_icode.erl b/lib/hipe/cerl/cerl_to_icode.erl index 1c1c10d9b0..ab131c2d01 100644 --- a/lib/hipe/cerl/cerl_to_icode.erl +++ b/lib/hipe/cerl/cerl_to_icode.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2012. All Rights Reserved. +%% Copyright Ericsson AB 2003-2015. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -29,9 +30,9 @@ -define(NO_UNUSED, true). --export([module/2]). +-export([module/1, module/2]). -ifndef(NO_UNUSED). --export([function/3, function/4, module/1]). +-export([function/3, function/4]). -endif. %% Added in an attempt to suppress message by Dialyzer, but I run into @@ -102,36 +103,32 @@ %% Record definitions --record(ctxt, {final = false :: boolean(), - effect = false, - fail = [], % [] or fail-to label - class = expr, % expr | guard - line = 0, % current line number - 'receive' % undefined | #receive{} - }). - -record('receive', {loop}). -record(cerl_to_icode__var, {name}). -record('fun', {label, vars}). +-record(ctxt, {final = false :: boolean(), + effect = false :: boolean(), + fail = [], % [] or fail-to label + class = expr :: 'expr' | 'guard', + line = 0 :: erl_anno:line(), % current line number + 'receive' :: 'undefined' | #'receive'{} + }). %% --------------------------------------------------------------------- %% Code - -%% @spec module(Module::cerl()) -> [icode()] +%% @spec module(Module::cerl()) -> [{mfa(), icode()}] %% @equiv module(Module, []) --ifndef(NO_UNUSED). +-spec module(cerl:c_module()) -> [{mfa(), hipe_icode:icode()}]. + module(E) -> module(E, []). --endif. -%% @clear - -%% @spec module(Module::cerl(), Options::[term()]) -> [icode()] +%% @spec module(Module::cerl(), Options::[term()]) -> [{mfa(), icode()}] %% -%% cerl() = cerl:cerl() +%% cerl() = cerl:c_module() %% icode() = hipe_icode:icode() %% %% @doc Transforms a Core Erlang module to linear HiPE Icode. The result @@ -149,7 +146,7 @@ module(E) -> %% @see function/4 %% @see cerl_hipeify:transform/1 -%% -spec module(cerl:c_module(), [term()]) -> [{mfa(), hipe_icode:icode()}]. +-spec module(cerl:c_module(), [term()]) -> [{mfa(), hipe_icode:icode()}]. module(E, Options) -> module_1(cerl_hipeify:transform(E, Options), Options). @@ -163,8 +160,8 @@ module_1(E, Options) -> throw(error) end, S0 = init(M), - S1 = s__set_pmatch(proplists:get_value(pmatch, Options), S0), - S2 = s__set_bitlevel_binaries(proplists:get_value( + S1 = s__set_pmatch(proplists:get_value(pmatch, Options), S0), + S2 = s__set_bitlevel_binaries(proplists:get_value( bitlevel_binaries, Options), S1), {Icode, _} = lists:mapfoldl(fun function_definition/2, S2, cerl:module_defs(E)), @@ -797,9 +794,9 @@ bitstr_gen_op([V], #ctxt{fail=FL, class=guard}, SizeInfo, ConstInfo, Type, Flags, Base, Offset) -> SL = new_label(), case SizeInfo of - {all,_NewUnit, NewAlign, S1} -> + {all, NewUnit, NewAlign, S1} -> Type = binary, - Name = {bs_put_binary_all, Flags}, + Name = {bs_put_binary_all, NewUnit, Flags}, Primop = {hipe_bs_primop, Name}, {add_code([icode_guardop([Offset], Primop, [V, Base, Offset], SL, FL), @@ -822,9 +819,9 @@ bitstr_gen_op([V], #ctxt{fail=FL, class=guard}, SizeInfo, ConstInfo, bitstr_gen_op([V], _Ctxt, SizeInfo, ConstInfo, Type, Flags, Base, Offset) -> case SizeInfo of - {all, _NewUnit, NewAlign, S} -> + {all, NewUnit, NewAlign, S} -> Type = binary, - Name = {bs_put_binary_all, Flags}, + Name = {bs_put_binary_all, NewUnit, Flags}, Primop = {hipe_bs_primop, Name}, {add_code([icode_call_primop([Offset], Primop, [V, Base, Offset])], S), diff --git a/lib/hipe/cerl/cerl_typean.erl b/lib/hipe/cerl/cerl_typean.erl index ccd8903658..ddc48c7915 100644 --- a/lib/hipe/cerl/cerl_typean.erl +++ b/lib/hipe/cerl/cerl_typean.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2009. All Rights Reserved. +%% Copyright Ericsson AB 2003-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -242,7 +243,7 @@ delete_ann(_, []) -> -type labelset() :: ordset(label()). -type outlist() :: [labelset()] | 'none'. --spec analyze(cerl:cerl()) -> {outlist(), dict(), dict()}. +-spec analyze(cerl:cerl()) -> {outlist(), dict:dict(), dict:dict()}. analyze(Tree) -> analyze(Tree, ?DEF_LIMIT). diff --git a/lib/hipe/cerl/erl_bif_types.erl b/lib/hipe/cerl/erl_bif_types.erl index 42c7e360c1..9453ca6c6f 100644 --- a/lib/hipe/cerl/erl_bif_types.erl +++ b/lib/hipe/cerl/erl_bif_types.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2013. All Rights Reserved. +%% Copyright Ericsson AB 2003-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -30,24 +31,21 @@ %-define(BITS, (hipe_rtl_arch:word_size() * 8) - ?TAG_IMMED1_SIZE). -define(BITS, 128). %This is only in bsl to convert answer to pos_inf/neg_inf. --define(TAG_IMMED1_SIZE, 4). - --export([type/3, type/4, arg_types/3, - is_known/3, structure_inspecting_args/3, infinity_add/2]). +-export([type/3, type/4, type/5, arg_types/3, + is_known/3, opaque_args/5, infinity_add/2]). --import(erl_types, [number_max/1, - number_min/1, +-import(erl_types, [number_max/2, + number_min/2, t_any/0, t_arity/0, t_atom/0, t_atom/1, t_atoms/1, - t_atom_vals/1, + t_atom_vals/2, t_binary/0, t_bitstr/0, t_boolean/0, t_byte/0, - t_char/0, t_cons/0, t_cons/2, t_cons_hd/1, @@ -60,10 +58,11 @@ t_from_term/1, t_fun/0, t_fun/2, - t_fun_args/1, - t_fun_range/1, + t_fun_args/2, + t_fun_range/2, t_identifier/0, - t_inf/2, + t_has_opaque_subtype/2, + t_inf/3, t_integer/0, t_integer/1, t_non_neg_fixnum/0, @@ -71,31 +70,28 @@ t_pos_integer/0, t_integers/1, t_is_any/1, - t_is_atom/1, - t_is_binary/1, - t_is_bitstr/1, - t_is_boolean/1, - t_is_cons/1, - t_is_float/1, - t_is_float/1, - t_is_fun/1, - t_is_integer/1, - t_is_integer/1, - t_is_nil/1, + t_is_atom/2, + t_is_binary/2, + t_is_bitstr/2, + t_is_boolean/2, + t_is_cons/2, + t_is_float/2, + t_is_fun/2, + t_is_integer/2, + t_is_nil/1, t_is_nil/2, t_is_none/1, t_is_none_or_unit/1, - t_is_number/1, - t_is_pid/1, - t_is_port/1, - t_is_maybe_improper_list/1, - t_is_reference/1, - t_is_string/1, + t_is_number/2, + t_is_pid/2, + t_is_port/2, + t_is_maybe_improper_list/2, + t_is_reference/2, t_is_subtype/2, - t_is_tuple/1, + t_is_tuple/2, t_list/0, t_list/1, - t_list_elements/1, - t_list_termination/1, + t_list_elements/2, + t_list_termination/2, t_mfa/0, t_module/0, t_nil/0, @@ -104,7 +100,7 @@ t_nonempty_list/0, t_nonempty_list/1, t_number/0, - t_number_vals/1, + t_number_vals/2, t_pid/0, t_port/0, t_maybe_improper_list/0, @@ -115,9 +111,20 @@ t_sup/2, t_tuple/0, t_tuple/1, - t_tuple_args/1, - t_tuple_size/1, - t_tuple_subtypes/1 + t_tuple_args/2, + t_tuple_size/2, + t_tuple_subtypes/2, + t_is_map/2, + t_map/0, + t_map/3, + t_map_def_key/2, + t_map_def_val/2, + t_map_get/3, + t_map_is_key/3, + t_map_entries/2, + t_map_put/3, + t_map_update/3, + map_pairwise_merge/3 ]). -ifdef(DO_ERL_BIF_TYPES_TEST). @@ -129,47 +136,61 @@ -spec type(atom(), atom(), arity()) -> erl_types:erl_type(). type(M, F, A) -> - type(M, F, A, any_list(A)). + type(M, F, A, any_list(A), []). %% Arguments should be checked for undefinedness, so we do not make %% unnecessary overapproximations. -spec type(atom(), atom(), arity(), [erl_types:erl_type()]) -> erl_types:erl_type(). +type(M, F, A, Xs) -> + type(M, F, A, Xs, 'universe'). + +-type opaques() :: erl_types:opaques(). + +-type arg_types() :: [erl_types:erl_type()]. + +-spec type(atom(), atom(), arity(), arg_types(), opaques()) -> + erl_types:erl_type(). + %%-- erlang ------------------------------------------------------------------- -type(erlang, halt, 0, _) -> t_none(); -type(erlang, halt, 1, _) -> t_none(); -type(erlang, halt, 2, _) -> t_none(); -type(erlang, exit, 1, _) -> t_none(); -type(erlang, error, 1, _) -> t_none(); -type(erlang, error, 2, _) -> t_none(); -type(erlang, throw, 1, _) -> t_none(); -type(erlang, '==', 2, Xs = [X1, X2]) -> - case t_is_atom(X1) andalso t_is_atom(X2) of - true -> type(erlang, '=:=', 2, Xs); +type(erlang, halt, 0, _, _) -> t_none(); +type(erlang, halt, 1, _, _) -> t_none(); +type(erlang, halt, 2, _, _) -> t_none(); +type(erlang, exit, 1, _, _) -> t_none(); +type(erlang, error, 1, _, _) -> t_none(); +type(erlang, error, 2, _, _) -> t_none(); +type(erlang, throw, 1, _, _) -> t_none(); +type(erlang, '==', 2, Xs = [X1, X2], Opaques) -> + case + t_is_atom(X1, Opaques) andalso t_is_atom(X2, Opaques) + of + true -> type(erlang, '=:=', 2, Xs, Opaques); false -> - case t_is_integer(X1) andalso t_is_integer(X2) of - true -> type(erlang, '=:=', 2, Xs); - false -> strict(Xs, t_boolean()) + case t_is_integer(X1, Opaques) andalso t_is_integer(X2, Opaques) of + true -> type(erlang, '=:=', 2, Xs, Opaques); + false -> strict2(Xs, t_boolean()) end end; -type(erlang, '/=', 2, Xs = [X1, X2]) -> - case t_is_atom(X1) andalso t_is_atom(X2) of - true -> type(erlang, '=/=', 2, Xs); +type(erlang, '/=', 2, Xs = [X1, X2], Opaques) -> + case + t_is_atom(X1, Opaques) andalso t_is_atom(X2, Opaques) + of + true -> type(erlang, '=/=', 2, Xs, Opaques); false -> - case t_is_integer(X1) andalso t_is_integer(X2) of - true -> type(erlang, '=/=', 2, Xs); - false -> strict(Xs, t_boolean()) + case t_is_integer(X1, Opaques) andalso t_is_integer(X2, Opaques) of + true -> type(erlang, '=/=', 2, Xs, Opaques); + false -> strict2(Xs, t_boolean()) end end; -type(erlang, '=:=', 2, Xs = [Lhs, Rhs]) -> +type(erlang, '=:=', 2, Xs = [Lhs, Rhs], Opaques) -> Ans = - case t_is_none(t_inf(Lhs, Rhs)) of + case t_is_none(t_inf(Lhs, Rhs, Opaques)) of true -> t_atom('false'); false -> - case t_is_atom(Lhs) andalso t_is_atom(Rhs) of + case t_is_atom(Lhs, Opaques) andalso t_is_atom(Rhs, Opaques) of true -> - case {t_atom_vals(Lhs), t_atom_vals(Rhs)} of + case {t_atom_vals(Lhs, Opaques), t_atom_vals(Rhs, Opaques)} of {unknown, _} -> t_boolean(); {_, unknown} -> t_boolean(); {[X], [X]} -> t_atom('true'); @@ -181,16 +202,20 @@ type(erlang, '=:=', 2, Xs = [Lhs, Rhs]) -> end end; false -> - case t_is_integer(Lhs) andalso t_is_integer(Rhs) of + case + t_is_integer(Lhs, Opaques) andalso t_is_integer(Rhs, Opaques) + of false -> t_boolean(); true -> - case {t_number_vals(Lhs), t_number_vals(Rhs)} of + case + {t_number_vals(Lhs, Opaques), t_number_vals(Rhs, Opaques)} + of {[X], [X]} when is_integer(X) -> t_atom('true'); _ -> - LhsMax = number_max(Lhs), - LhsMin = number_min(Lhs), - RhsMax = number_max(Rhs), - RhsMin = number_min(Rhs), + LhsMax = number_max(Lhs, Opaques), + LhsMin = number_min(Lhs, Opaques), + RhsMax = number_max(Rhs, Opaques), + RhsMin = number_min(Rhs, Opaques), Ans1 = (is_integer(LhsMin) andalso is_integer(RhsMax) andalso (LhsMin > RhsMax)), @@ -205,15 +230,15 @@ type(erlang, '=:=', 2, Xs = [Lhs, Rhs]) -> end end end, - strict(Xs, Ans); -type(erlang, '=/=', 2, Xs = [Lhs, Rhs]) -> + strict2(Xs, Ans); +type(erlang, '=/=', 2, Xs = [Lhs, Rhs], Opaques) -> Ans = - case t_is_none(t_inf(Lhs, Rhs)) of + case t_is_none(t_inf(Lhs, Rhs, Opaques)) of true -> t_atom('true'); false -> - case t_is_atom(Lhs) andalso t_is_atom(Rhs) of + case t_is_atom(Lhs, Opaques) andalso t_is_atom(Rhs, Opaques) of true -> - case {t_atom_vals(Lhs), t_atom_vals(Rhs)} of + case {t_atom_vals(Lhs, Opaques), t_atom_vals(Rhs, Opaques)} of {unknown, _} -> t_boolean(); {_, unknown} -> t_boolean(); {[Val], [Val]} -> t_atom('false'); @@ -221,13 +246,15 @@ type(erlang, '=/=', 2, Xs = [Lhs, Rhs]) -> t_sup([t_from_term(X =/= Y) || X <- LhsVals, Y <- RhsVals]) end; false -> - case t_is_integer(Lhs) andalso t_is_integer(Rhs) of + case + t_is_integer(Lhs, Opaques) andalso t_is_integer(Rhs, Opaques) + of false -> t_boolean(); true -> - LhsMax = number_max(Lhs), - LhsMin = number_min(Lhs), - RhsMax = number_max(Rhs), - RhsMin = number_min(Rhs), + LhsMax = number_max(Lhs, Opaques), + LhsMin = number_min(Lhs, Opaques), + RhsMax = number_max(Rhs, Opaques), + RhsMin = number_min(Rhs, Opaques), Ans1 = (is_integer(LhsMin) andalso is_integer(RhsMax) andalso (LhsMin > RhsMax)), Ans2 = (is_integer(LhsMax) andalso is_integer(RhsMin) @@ -244,15 +271,15 @@ type(erlang, '=/=', 2, Xs = [Lhs, Rhs]) -> end end end, - strict(Xs, Ans); -type(erlang, '>', 2, Xs = [Lhs, Rhs]) -> + strict2(Xs, Ans); +type(erlang, '>', 2, Xs = [Lhs, Rhs], Opaques) -> Ans = - case t_is_integer(Lhs) andalso t_is_integer(Rhs) of + case t_is_integer(Lhs, Opaques) andalso t_is_integer(Rhs, Opaques) of true -> - LhsMax = number_max(Lhs), - LhsMin = number_min(Lhs), - RhsMax = number_max(Rhs), - RhsMin = number_min(Rhs), + LhsMax = number_max(Lhs, Opaques), + LhsMin = number_min(Lhs, Opaques), + RhsMax = number_max(Rhs, Opaques), + RhsMin = number_min(Rhs, Opaques), T = t_atom('true'), F = t_atom('false'), if @@ -260,17 +287,17 @@ type(erlang, '>', 2, Xs = [Lhs, Rhs]) -> is_integer(LhsMax), is_integer(RhsMin), RhsMin >= LhsMax -> F; true -> t_boolean() end; - false -> compare('>', Lhs, Rhs) + false -> compare('>', Lhs, Rhs, Opaques) end, - strict(Xs, Ans); -type(erlang, '>=', 2, Xs = [Lhs, Rhs]) -> + strict2(Xs, Ans); +type(erlang, '>=', 2, Xs = [Lhs, Rhs], Opaques) -> Ans = - case t_is_integer(Lhs) andalso t_is_integer(Rhs) of + case t_is_integer(Lhs, Opaques) andalso t_is_integer(Rhs, Opaques) of true -> - LhsMax = number_max(Lhs), - LhsMin = number_min(Lhs), - RhsMax = number_max(Rhs), - RhsMin = number_min(Rhs), + LhsMax = number_max(Lhs, Opaques), + LhsMin = number_min(Lhs, Opaques), + RhsMax = number_max(Rhs, Opaques), + RhsMin = number_min(Rhs, Opaques), T = t_atom('true'), F = t_atom('false'), if @@ -278,17 +305,17 @@ type(erlang, '>=', 2, Xs = [Lhs, Rhs]) -> is_integer(LhsMax), is_integer(RhsMin), RhsMin > LhsMax -> F; true -> t_boolean() end; - false -> compare('>=', Lhs, Rhs) + false -> compare('>=', Lhs, Rhs, Opaques) end, - strict(Xs, Ans); -type(erlang, '<', 2, Xs = [Lhs, Rhs]) -> + strict2(Xs, Ans); +type(erlang, '<', 2, Xs = [Lhs, Rhs], Opaques) -> Ans = - case t_is_integer(Lhs) andalso t_is_integer(Rhs) of + case t_is_integer(Lhs, Opaques) andalso t_is_integer(Rhs, Opaques) of true -> - LhsMax = number_max(Lhs), - LhsMin = number_min(Lhs), - RhsMax = number_max(Rhs), - RhsMin = number_min(Rhs), + LhsMax = number_max(Lhs, Opaques), + LhsMin = number_min(Lhs, Opaques), + RhsMax = number_max(Rhs, Opaques), + RhsMin = number_min(Rhs, Opaques), T = t_atom('true'), F = t_atom('false'), if @@ -296,17 +323,17 @@ type(erlang, '<', 2, Xs = [Lhs, Rhs]) -> is_integer(LhsMin), is_integer(RhsMax), RhsMax =< LhsMin -> F; true -> t_boolean() end; - false -> compare('<', Lhs, Rhs) + false -> compare('<', Lhs, Rhs, Opaques) end, - strict(Xs, Ans); -type(erlang, '=<', 2, Xs = [Lhs, Rhs]) -> + strict2(Xs, Ans); +type(erlang, '=<', 2, Xs = [Lhs, Rhs], Opaques) -> Ans = - case t_is_integer(Lhs) andalso t_is_integer(Rhs) of + case t_is_integer(Lhs, Opaques) andalso t_is_integer(Rhs, Opaques) of true -> - LhsMax = number_max(Lhs), - LhsMin = number_min(Lhs), - RhsMax = number_max(Rhs), - RhsMin = number_min(Rhs), + LhsMax = number_max(Lhs, Opaques), + LhsMin = number_min(Lhs, Opaques), + RhsMax = number_max(Rhs, Opaques), + RhsMin = number_min(Rhs, Opaques), T = t_atom('true'), F = t_atom('false'), if @@ -314,232 +341,235 @@ type(erlang, '=<', 2, Xs = [Lhs, Rhs]) -> is_integer(LhsMin), is_integer(RhsMax), RhsMax < LhsMin -> F; true -> t_boolean() end; - false -> compare('=<', Lhs, Rhs) + false -> compare('=<', Lhs, Rhs, Opaques) end, - strict(Xs, Ans); -type(erlang, '+', 1, Xs) -> - strict(arg_types(erlang, '+', 1), Xs, - fun ([X]) -> X end); -type(erlang, '-', 1, Xs) -> - strict(arg_types(erlang, '-', 1), Xs, + strict2(Xs, Ans); +type(erlang, '+', 1, Xs, Opaques) -> + strict(erlang, '+', 1, Xs, fun ([X]) -> X end, Opaques); +type(erlang, '-', 1, Xs, Opaques) -> + strict(erlang, '-', 1, Xs, fun ([X]) -> - case t_is_integer(X) of + case t_is_integer(X, Opaques) of true -> type(erlang, '-', 2, [t_integer(0), X]); false -> X end - end); -type(erlang, '!', 2, Xs) -> - strict(arg_types(erlang, '!', 2), Xs, fun ([_, X2]) -> X2 end); -type(erlang, '+', 2, Xs) -> - strict(arg_types(erlang, '+', 2), Xs, + end, Opaques); +type(erlang, '!', 2, Xs, Opaques) -> + strict(erlang, '!', 2, Xs, fun ([_, X2]) -> X2 end, Opaques); +type(erlang, '+', 2, Xs, Opaques) -> + strict(erlang, '+', 2, Xs, fun ([X1, X2]) -> - case arith('+', X1, X2) of + case arith('+', X1, X2, Opaques) of {ok, T} -> T; error -> - case t_is_float(X1) orelse t_is_float(X2) of + case + t_is_float(X1, Opaques) orelse t_is_float(X2, Opaques) + of true -> t_float(); false -> t_number() end end - end); -type(erlang, '-', 2, Xs) -> - strict(arg_types(erlang, '-', 2), Xs, + end, Opaques); +type(erlang, '-', 2, Xs, Opaques) -> + strict(erlang, '-', 2, Xs, fun ([X1, X2]) -> - case arith('-', X1, X2) of + case arith('-', X1, X2, Opaques) of {ok, T} -> T; error -> - case t_is_float(X1) orelse t_is_float(X2) of + case + t_is_float(X1, Opaques) orelse t_is_float(X2, Opaques) + of true -> t_float(); false -> t_number() end end - end); -type(erlang, '*', 2, Xs) -> - strict(arg_types(erlang, '*', 2), Xs, + end, Opaques); +type(erlang, '*', 2, Xs, Opaques) -> + strict(erlang, '*', 2, Xs, fun ([X1, X2]) -> - case arith('*', X1, X2) of + case arith('*', X1, X2, Opaques) of {ok, T} -> T; error -> - case t_is_float(X1) orelse t_is_float(X2) of + case + t_is_float(X1, Opaques) orelse t_is_float(X2, Opaques) + of true -> t_float(); false -> t_number() end end - end); -type(erlang, '/', 2, Xs) -> - strict(arg_types(erlang, '/', 2), Xs, - fun (_) -> t_float() end); -type(erlang, 'div', 2, Xs) -> - strict(arg_types(erlang, 'div', 2), Xs, + end, Opaques); +type(erlang, '/', 2, Xs, Opaques) -> + strict(erlang, '/', 2, Xs, fun (_) -> t_float() end, Opaques); +type(erlang, 'div', 2, Xs, Opaques) -> + strict(erlang, 'div', 2, Xs, fun ([X1, X2]) -> - case arith('div', X1, X2) of + case arith('div', X1, X2, Opaques) of error -> t_integer(); {ok, T} -> T end - end); -type(erlang, 'rem', 2, Xs) -> - strict(arg_types(erlang, 'rem', 2), Xs, + end, Opaques); +type(erlang, 'rem', 2, Xs, Opaques) -> + strict(erlang, 'rem', 2, Xs, fun ([X1, X2]) -> - case arith('rem', X1, X2) of + case arith('rem', X1, X2, Opaques) of error -> t_non_neg_integer(); {ok, T} -> T end - end); -type(erlang, '++', 2, Xs) -> - strict(arg_types(erlang, '++', 2), Xs, + end, Opaques); +type(erlang, '++', 2, Xs, Opaques) -> + strict(erlang, '++', 2, Xs, fun ([X1, X2]) -> - case t_is_nil(X1) of + case t_is_nil(X1, Opaques) of true -> X2; % even if X2 is not a list false -> - case t_is_nil(X2) of + case t_is_nil(X2, Opaques) of true -> X1; false -> - E1 = t_list_elements(X1), - case t_is_cons(X1) of + E1 = t_list_elements(X1, Opaques), + case t_is_cons(X1, Opaques) of true -> t_cons(E1, X2); false -> t_sup(X2, t_cons(E1, X2)) end end end - end); -type(erlang, '--', 2, Xs) -> + end, Opaques); +type(erlang, '--', 2, Xs, Opaques) -> %% We don't know which elements (if any) in X2 will be found and %% removed from X1, even if they would have the same type. Thus, we %% must assume that X1 can remain unchanged. However, if we succeed, %% we know that X1 must be a proper list, but the result could %% possibly be empty even if X1 is nonempty. - strict(arg_types(erlang, '--', 2), Xs, + strict(erlang, '--', 2, Xs, fun ([X1, X2]) -> - case t_is_nil(X1) of + case t_is_nil(X1, Opaques) of true -> t_nil(); false -> - case t_is_nil(X2) of + case t_is_nil(X2, Opaques) of true -> X1; - false -> t_list(t_list_elements(X1)) + false -> t_list(t_list_elements(X1, Opaques)) end end - end); -type(erlang, 'and', 2, Xs) -> - strict(arg_types(erlang, 'and', 2), Xs, fun (_) -> t_boolean() end); -type(erlang, 'or', 2, Xs) -> - strict(arg_types(erlang, 'or', 2), Xs, fun (_) -> t_boolean() end); -type(erlang, 'xor', 2, Xs) -> - strict(arg_types(erlang, 'xor', 2), Xs, fun (_) -> t_boolean() end); -type(erlang, 'not', 1, Xs) -> - strict(arg_types(erlang, 'not', 1), Xs, fun (_) -> t_boolean() end); -type(erlang, 'band', 2, Xs) -> - strict(arg_types(erlang, 'band', 2), Xs, + end, Opaques); +type(erlang, 'and', 2, Xs, Opaques) -> + strict(erlang, 'and', 2, Xs, fun (_) -> t_boolean() end, Opaques); +type(erlang, 'or', 2, Xs, Opaques) -> + strict(erlang, 'or', 2, Xs, fun (_) -> t_boolean() end, Opaques); +type(erlang, 'xor', 2, Xs, Opaques) -> + strict(erlang, 'xor', 2, Xs, fun (_) -> t_boolean() end, Opaques); +type(erlang, 'not', 1, Xs, Opaques) -> + strict(erlang, 'not', 1, Xs, fun (_) -> t_boolean() end, Opaques); +type(erlang, 'band', 2, Xs, Opaques) -> + strict(erlang, 'band', 2, Xs, fun ([X1, X2]) -> - case arith('band', X1, X2) of + case arith('band', X1, X2, Opaques) of error -> t_integer(); {ok, T} -> T end - end); + end, Opaques); %% The result is not wider than the smallest argument. We need to %% kill any value-sets in the result. -%% strict(arg_types(erlang, 'band', 2), Xs, -%% fun ([X1, X2]) -> t_sup(t_inf(X1, X2), t_byte()) end); -type(erlang, 'bor', 2, Xs) -> - strict(arg_types(erlang, 'bor', 2), Xs, +%% strict(erlang, 'band', 2, Xs, +%% fun ([X1, X2]) -> t_sup(t_inf(X1, X2, Opaques), t_byte()) end, Opaques); +type(erlang, 'bor', 2, Xs, Opaques) -> + strict(erlang, 'bor', 2, Xs, fun ([X1, X2]) -> - case arith('bor', X1, X2) of + case arith('bor', X1, X2, Opaques) of error -> t_integer(); {ok, T} -> T end - end); + end, Opaques); %% The result is not wider than the largest argument. We need to %% kill any value-sets in the result. -%% strict(arg_types(erlang, 'bor', 2), Xs, -%% fun ([X1, X2]) -> t_sup(t_sup(X1, X2), t_byte()) end); -type(erlang, 'bxor', 2, Xs) -> - strict(arg_types(erlang, 'bxor', 2), Xs, +%% strict(erlang, 'bor', 2, Xs, +%% fun ([X1, X2]) -> t_sup(t_sup(X1, X2), t_byte()) end, Opaques); +type(erlang, 'bxor', 2, Xs, Opaques) -> + strict(erlang, 'bxor', 2, Xs, fun ([X1, X2]) -> - case arith('bxor', X1, X2) of + case arith('bxor', X1, X2, Opaques) of error -> t_integer(); {ok, T} -> T end - end); + end, Opaques); %% The result is not wider than the largest argument. We need to %% kill any value-sets in the result. -%% strict(arg_types(erlang, 'bxor', 2), Xs, -%% fun ([X1, X2]) -> t_sup(t_sup(X1, X2), t_byte()) end); -type(erlang, 'bsr', 2, Xs) -> - strict(arg_types(erlang, 'bsr', 2), Xs, +%% strict(erlang, 'bxor', 2, Xs, +%% fun ([X1, X2]) -> t_sup(t_sup(X1, X2), t_byte()) end, Opaques); +type(erlang, 'bsr', 2, Xs, Opaques) -> + strict(erlang, 'bsr', 2, Xs, fun ([X1, X2]) -> - case arith('bsr', X1, X2) of + case arith('bsr', X1, X2, Opaques) of error -> t_integer(); {ok, T} -> T end - end); + end, Opaques); %% If the first argument is unsigned (which is the case for %% characters and bytes), the result is never wider. We need to kill %% any value-sets in the result. -%% strict(arg_types(erlang, 'bsr', 2), Xs, -%% fun ([X, _]) -> t_sup(X, t_byte()) end); -type(erlang, 'bsl', 2, Xs) -> - strict(arg_types(erlang, 'bsl', 2), Xs, +%% strict(erlang, 'bsr', 2, Xs, +%% fun ([X, _]) -> t_sup(X, t_byte()) end, Opaques); +type(erlang, 'bsl', 2, Xs, Opaques) -> + strict(erlang, 'bsl', 2, Xs, fun ([X1, X2]) -> - case arith('bsl', X1, X2) of + case arith('bsl', X1, X2, Opaques) of error -> t_integer(); {ok, T} -> T end - end); + end, Opaques); %% Not worth doing anything special here. -%% strict(arg_types(erlang, 'bsl', 2), Xs, fun (_) -> t_integer() end); -type(erlang, 'bnot', 1, Xs) -> - strict(arg_types(erlang, 'bnot', 1), Xs, +%% strict(erlang, 'bsl', 2, Xs, fun (_) -> t_integer() end, Opaques); +type(erlang, 'bnot', 1, Xs, Opaques) -> + strict(erlang, 'bnot', 1, Xs, fun ([X1]) -> - case arith('bnot', X1) of + case arith_bnot(X1, Opaques) of error -> t_integer(); {ok, T} -> T end - end); + end, Opaques); %% Guard bif, needs to be here. -type(erlang, abs, 1, Xs) -> - strict(arg_types(erlang, abs, 1), Xs, fun ([X]) -> X end); +type(erlang, abs, 1, Xs, Opaques) -> + strict(erlang, abs, 1, Xs, + fun ([X1]) -> arith_abs(X1, Opaques) end, Opaques); %% This returns (-X)-1, so it often gives a negative result. -%% strict(arg_types(erlang, 'bnot', 1), Xs, fun (_) -> t_integer() end); -type(erlang, append, 2, Xs) -> type(erlang, '++', 2, Xs); % alias -type(erlang, apply, 2, Xs) -> +%% strict(erlang, 'bnot', 1, Xs, fun (_) -> t_integer() end, Opaques); +type(erlang, append, 2, Xs, _Opaques) -> type(erlang, '++', 2, Xs); % alias +type(erlang, apply, 2, Xs, Opaques) -> Fun = fun ([X, _Y]) -> - case t_is_fun(X) of + case t_is_fun(X, Opaques) of true -> - t_fun_range(X); + t_fun_range(X, Opaques); false -> t_any() end end, - strict(arg_types(erlang, apply, 2), Xs, Fun); -type(erlang, apply, 3, Xs) -> - strict(arg_types(erlang, apply, 3), Xs, fun (_) -> t_any() end); + strict(erlang, apply, 2, Xs, Fun, Opaques); +type(erlang, apply, 3, Xs, Opaques) -> + strict(erlang, apply, 3, Xs, fun (_) -> t_any() end, Opaques); %% Guard bif, needs to be here. -type(erlang, binary_part, 2, Xs) -> - strict(arg_types(erlang, binary_part, 2), Xs, fun (_) -> t_binary() end); +type(erlang, binary_part, 2, Xs, Opaques) -> + strict(erlang, binary_part, 2, Xs, fun (_) -> t_binary() end, Opaques); %% Guard bif, needs to be here. -type(erlang, binary_part, 3, Xs) -> - strict(arg_types(erlang, binary_part, 3), Xs, fun (_) -> t_binary() end); +type(erlang, binary_part, 3, Xs, Opaques) -> + strict(erlang, binary_part, 3, Xs, fun (_) -> t_binary() end, Opaques); %% Guard bif, needs to be here. -type(erlang, bit_size, 1, Xs) -> - strict(arg_types(erlang, bit_size, 1), Xs, - fun (_) -> t_non_neg_integer() end); +type(erlang, bit_size, 1, Xs, Opaques) -> + strict(erlang, bit_size, 1, Xs, + fun (_) -> t_non_neg_integer() end, Opaques); %% Guard bif, needs to be here. -type(erlang, byte_size, 1, Xs) -> - strict(arg_types(erlang, byte_size, 1), Xs, - fun (_) -> t_non_neg_integer() end); -type(erlang, disconnect_node, 1, Xs) -> - strict(arg_types(erlang, disconnect_node, 1), Xs, fun (_) -> t_sup([t_boolean(), t_atom('ignored')]) end); +type(erlang, byte_size, 1, Xs, Opaques) -> + strict(erlang, byte_size, 1, Xs, + fun (_) -> t_non_neg_integer() end, Opaques); %% Guard bif, needs to be here. %% Also much more expressive than anything you could write in a spec... -type(erlang, element, 2, Xs) -> - strict(arg_types(erlang, element, 2), Xs, +type(erlang, element, 2, Xs, Opaques) -> + strict(erlang, element, 2, Xs, fun ([X1, X2]) -> - case t_tuple_subtypes(X2) of + case t_tuple_subtypes(X2, Opaques) of unknown -> t_any(); [_] -> - Sz = t_tuple_size(X2), - As = t_tuple_args(X2), - case t_number_vals(X1) of + Sz = t_tuple_size(X2, Opaques), + As = t_tuple_args(X2, Opaques), + case t_number_vals(X1, Opaques) of unknown -> t_sup(As); Ns when is_list(Ns) -> Fun = fun @@ -553,165 +583,159 @@ type(erlang, element, 2, Xs) -> Ts when is_list(Ts) -> t_sup([type(erlang, element, 2, [X1, Y]) || Y <- Ts]) end - end); + end, Opaques); %% Guard bif, needs to be here. -type(erlang, float, 1, Xs) -> - strict(arg_types(erlang, float, 1), Xs, fun (_) -> t_float() end); -type(erlang, fun_info, 1, Xs) -> - strict(arg_types(erlang, fun_info, 1), Xs, - fun (_) -> t_list(t_tuple([t_atom(), t_any()])) end); -type(erlang, get_cookie, 0, _) -> t_atom(); % | t_atom('nocookie') +type(erlang, float, 1, Xs, Opaques) -> + strict(erlang, float, 1, Xs, fun (_) -> t_float() end, Opaques); %% Guard bif, needs to be here. -type(erlang, hd, 1, Xs) -> - strict(arg_types(erlang, hd, 1), Xs, fun ([X]) -> t_cons_hd(X) end); -type(erlang, integer_to_list, 2, Xs) -> - strict(arg_types(erlang, integer_to_list, 2), Xs, - fun (_) -> t_string() end); -type(erlang, info, 1, Xs) -> type(erlang, system_info, 1, Xs); % alias +type(erlang, hd, 1, Xs, Opaques) -> + strict(erlang, hd, 1, Xs, fun ([X]) -> t_cons_hd(X) end, Opaques); +type(erlang, info, 1, Xs, _) -> type(erlang, system_info, 1, Xs); % alias %% All type tests are guard BIF's and may be implemented in ways that %% cannot be expressed in a type spec, why they are kept in erl_bif_types. -type(erlang, is_atom, 1, Xs) -> - Fun = fun (X) -> check_guard(X, fun (Y) -> t_is_atom(Y) end, t_atom()) end, - strict(arg_types(erlang, is_atom, 1), Xs, Fun); -type(erlang, is_binary, 1, Xs) -> +type(erlang, is_atom, 1, Xs, Opaques) -> Fun = fun (X) -> - check_guard(X, fun (Y) -> t_is_binary(Y) end, t_binary()) + check_guard(X, fun (Y) -> t_is_atom(Y, Opaques) end, + t_atom(), Opaques) + end, + strict(erlang, is_atom, 1, Xs, Fun, Opaques); +type(erlang, is_binary, 1, Xs, Opaques) -> + Fun = fun (X) -> + check_guard(X, fun (Y) -> t_is_binary(Y, Opaques) end, + t_binary(), Opaques) end, - strict(arg_types(erlang, is_binary, 1), Xs, Fun); -type(erlang, is_bitstring, 1, Xs) -> + strict(erlang, is_binary, 1, Xs, Fun, Opaques); +type(erlang, is_bitstring, 1, Xs, Opaques) -> Fun = fun (X) -> - check_guard(X, fun (Y) -> t_is_bitstr(Y) end, t_bitstr()) + check_guard(X, fun (Y) -> t_is_bitstr(Y, Opaques) end, + t_bitstr(), Opaques) end, - strict(arg_types(erlang, is_bitstring, 1), Xs, Fun); -type(erlang, is_boolean, 1, Xs) -> + strict(erlang, is_bitstring, 1, Xs, Fun, Opaques); +type(erlang, is_boolean, 1, Xs, Opaques) -> Fun = fun (X) -> - check_guard(X, fun (Y) -> t_is_boolean(Y) end, t_boolean()) + check_guard(X, fun (Y) -> t_is_boolean(Y, Opaques) end, + t_boolean(), Opaques) end, - strict(arg_types(erlang, is_boolean, 1), Xs, Fun); -type(erlang, is_float, 1, Xs) -> + strict(erlang, is_boolean, 1, Xs, Fun, Opaques); +type(erlang, is_float, 1, Xs, Opaques) -> Fun = fun (X) -> - check_guard(X, fun (Y) -> t_is_float(Y) end, t_float()) + check_guard(X, fun (Y) -> t_is_float(Y, Opaques) end, + t_float(), Opaques) end, - strict(arg_types(erlang, is_float, 1), Xs, Fun); -type(erlang, is_function, 1, Xs) -> - Fun = fun (X) -> check_guard(X, fun (Y) -> t_is_fun(Y) end, t_fun()) end, - strict(arg_types(erlang, is_function, 1), Xs, Fun); -type(erlang, is_function, 2, Xs) -> + strict(erlang, is_float, 1, Xs, Fun, Opaques); +type(erlang, is_function, 1, Xs, Opaques) -> + Fun = fun (X) -> + check_guard(X, fun (Y) -> t_is_fun(Y, Opaques) end, + t_fun(), Opaques) + end, + strict(erlang, is_function, 1, Xs, Fun, Opaques); +type(erlang, is_function, 2, Xs, Opaques) -> Fun = fun ([FunType, ArityType]) -> - case t_number_vals(ArityType) of + case t_number_vals(ArityType, Opaques) of unknown -> t_boolean(); [Val] -> FunConstr = t_fun(any_list(Val), t_any()), Fun2 = fun (X) -> t_is_subtype(X, FunConstr) andalso (not t_is_none(X)) end, - check_guard_single(FunType, Fun2, FunConstr); + check_guard_single(FunType, Fun2, FunConstr, Opaques); IntList when is_list(IntList) -> t_boolean() %% true? end end, - strict(arg_types(erlang, is_function, 2), Xs, Fun); -type(erlang, is_integer, 1, Xs) -> + strict(erlang, is_function, 2, Xs, Fun, Opaques); +type(erlang, is_integer, 1, Xs, Opaques) -> Fun = fun (X) -> - check_guard(X, fun (Y) -> t_is_integer(Y) end, t_integer()) + check_guard(X, fun (Y) -> t_is_integer(Y, Opaques) end, + t_integer(), Opaques) end, - strict(arg_types(erlang, is_integer, 1), Xs, Fun); -type(erlang, is_list, 1, Xs) -> + strict(erlang, is_integer, 1, Xs, Fun, Opaques); +type(erlang, is_list, 1, Xs, Opaques) -> Fun = fun (X) -> - Fun2 = fun (Y) -> t_is_maybe_improper_list(Y) end, - check_guard(X, Fun2, t_maybe_improper_list()) + Fun2 = fun (Y) -> t_is_maybe_improper_list(Y, Opaques) end, + check_guard(X, Fun2, t_maybe_improper_list(), Opaques) end, - strict(arg_types(erlang, is_list, 1), Xs, Fun); -type(erlang, is_number, 1, Xs) -> + strict(erlang, is_list, 1, Xs, Fun, Opaques); +type(erlang, is_map, 1, Xs, Opaques) -> + Fun = fun (X) -> + check_guard(X, fun (Y) -> t_is_map(Y, Opaques) end, + t_map(), Opaques) end, + strict(erlang, is_map, 1, Xs, Fun, Opaques); +type(erlang, is_number, 1, Xs, Opaques) -> Fun = fun (X) -> - check_guard(X, fun (Y) -> t_is_number(Y) end, t_number()) + check_guard(X, fun (Y) -> t_is_number(Y, Opaques) end, + t_number(), Opaques) end, - strict(arg_types(erlang, is_number, 1), Xs, Fun); -type(erlang, is_pid, 1, Xs) -> - Fun = fun (X) -> check_guard(X, fun (Y) -> t_is_pid(Y) end, t_pid()) end, - strict(arg_types(erlang, is_pid, 1), Xs, Fun); -type(erlang, is_port, 1, Xs) -> - Fun = fun (X) -> check_guard(X, fun (Y) -> t_is_port(Y) end, t_port()) end, - strict(arg_types(erlang, is_port, 1), Xs, Fun); -type(erlang, is_record, 2, Xs) -> + strict(erlang, is_number, 1, Xs, Fun, Opaques); +type(erlang, is_pid, 1, Xs, Opaques) -> + Fun = fun (X) -> + check_guard(X, fun (Y) -> t_is_pid(Y, Opaques) end, + t_pid(), Opaques) + end, + strict(erlang, is_pid, 1, Xs, Fun, Opaques); +type(erlang, is_port, 1, Xs, Opaques) -> + Fun = fun (X) -> + check_guard(X, fun (Y) -> t_is_port(Y, Opaques) end, + t_port(), Opaques) + end, + strict(erlang, is_port, 1, Xs, Fun, Opaques); +type(erlang, is_record, 2, Xs, Opaques) -> Fun = fun ([X, Y]) -> - case t_is_tuple(X) of + case t_is_tuple(X, Opaques) of false -> - case t_is_none(t_inf(t_tuple(), X)) of - true -> t_atom('false'); + case t_is_none(t_inf(t_tuple(), X, Opaques)) of + true -> + case t_has_opaque_subtype(X, Opaques) of + true -> t_none(); + false -> t_atom('false') + end; false -> t_boolean() end; true -> - case t_tuple_subtypes(X) of + case t_tuple_subtypes(X, Opaques) of unknown -> t_boolean(); [Tuple] -> - case t_tuple_args(Tuple) of + case t_tuple_args(Tuple, Opaques) of %% any -> t_boolean(); - [Tag|_] -> - case t_is_atom(Tag) of - false -> - TagAtom = t_inf(Tag, t_atom()), - case t_is_none(TagAtom) of - true -> t_atom('false'); - false -> t_boolean() - end; - true -> - case t_atom_vals(Tag) of - [RealTag] -> - case t_atom_vals(Y) of - [RealTag] -> t_atom('true'); - _ -> t_boolean() - end; - _ -> t_boolean() - end - end + [Tag|_] -> check_record_tag(Tag, Y, Opaques) end; List when length(List) >= 2 -> t_sup([type(erlang, is_record, 2, [T, Y]) || T <- List]) end end end, - strict(arg_types(erlang, is_record, 2), Xs, Fun); -type(erlang, is_record, 3, Xs) -> + strict(erlang, is_record, 2, Xs, Fun, Opaques); +type(erlang, is_record, 3, Xs, Opaques) -> Fun = fun ([X, Y, Z]) -> - Arity = t_number_vals(Z), - case t_is_tuple(X) of + Arity = t_number_vals(Z, Opaques), + case t_is_tuple(X, Opaques) of false when length(Arity) =:= 1 -> [RealArity] = Arity, - case t_is_none(t_inf(t_tuple(RealArity), X)) of - true -> t_atom('false'); + case t_is_none(t_inf(t_tuple(RealArity), X, Opaques)) of + true -> + case t_has_opaque_subtype(X, Opaques) of + true -> t_none(); + false -> t_atom('false') + end; false -> t_boolean() end; false -> - case t_is_none(t_inf(t_tuple(), X)) of - true -> t_atom('false'); + case t_is_none(t_inf(t_tuple(), X, Opaques)) of + true -> + case t_has_opaque_subtype(X, Opaques) of + true -> t_none(); + false -> t_atom('false') + end; false -> t_boolean() end; true when length(Arity) =:= 1 -> [RealArity] = Arity, - case t_tuple_subtypes(X) of + case t_tuple_subtypes(X, Opaques) of unknown -> t_boolean(); [Tuple] -> - case t_tuple_args(Tuple) of + case t_tuple_args(Tuple, Opaques) of %% any -> t_boolean(); Args when length(Args) =:= RealArity -> - Tag = hd(Args), - case t_is_atom(Tag) of - false -> - TagAtom = t_inf(Tag, t_atom()), - case t_is_none(TagAtom) of - true -> t_atom('false'); - false -> t_boolean() - end; - true -> - case t_atom_vals(Tag) of - [RealTag] -> - case t_atom_vals(Y) of - [RealTag] -> t_atom('true'); - _ -> t_boolean() - end; - _ -> t_boolean() - end - end; + check_record_tag(hd(Args), Y, Opaques); Args when length(Args) =/= RealArity -> t_atom('false') end; @@ -722,62 +746,77 @@ type(erlang, is_record, 3, Xs) -> t_boolean() end end, - strict(arg_types(erlang, is_record, 3), Xs, Fun); -type(erlang, is_reference, 1, Xs) -> + strict(erlang, is_record, 3, Xs, Fun, Opaques); +type(erlang, is_reference, 1, Xs, Opaques) -> Fun = fun (X) -> - check_guard(X, fun (Y) -> t_is_reference(Y) end, t_reference()) + check_guard(X, fun (Y) -> t_is_reference(Y, Opaques) end, + t_reference(), Opaques) end, - strict(arg_types(erlang, is_reference, 1), Xs, Fun); -type(erlang, is_tuple, 1, Xs) -> + strict(erlang, is_reference, 1, Xs, Fun, Opaques); +type(erlang, is_tuple, 1, Xs, Opaques) -> Fun = fun (X) -> - check_guard(X, fun (Y) -> t_is_tuple(Y) end, t_tuple()) + check_guard(X, fun (Y) -> t_is_tuple(Y, Opaques) end, + t_tuple(), Opaques) end, - strict(arg_types(erlang, is_tuple, 1), Xs, Fun); + strict(erlang, is_tuple, 1, Xs, Fun, Opaques); +%% Guard bif, needs to be here. +type(erlang, length, 1, Xs, Opaques) -> + strict(erlang, length, 1, Xs, fun (_) -> t_non_neg_fixnum() end, Opaques); %% Guard bif, needs to be here. -type(erlang, length, 1, Xs) -> - strict(arg_types(erlang, length, 1), Xs, fun (_) -> t_non_neg_fixnum() end); -type(erlang, make_tuple, 2, Xs) -> - strict(arg_types(erlang, make_tuple, 2), Xs, +type(erlang, map_size, 1, Xs, Opaques) -> + type(maps, size, 1, Xs, Opaques); +type(erlang, make_fun, 3, Xs, Opaques) -> + strict(erlang, make_fun, 3, Xs, + fun ([_, _, Arity]) -> + case t_number_vals(Arity, Opaques) of + [N] -> + case is_integer(N) andalso 0 =< N andalso N =< 255 of + true -> t_fun(N, t_any()); + false -> t_none() + end; + _Other -> t_fun() + end + end, Opaques); +type(erlang, make_tuple, 2, Xs, Opaques) -> + strict(erlang, make_tuple, 2, Xs, fun ([Int, _]) -> - case t_number_vals(Int) of + case t_number_vals(Int, Opaques) of [N] when is_integer(N), N >= 0 -> t_tuple(N); _Other -> t_tuple() end - end); -type(erlang, make_tuple, 3, Xs) -> - strict(arg_types(erlang, make_tuple, 3), Xs, + end, Opaques); +type(erlang, make_tuple, 3, Xs, Opaques) -> + strict(erlang, make_tuple, 3, Xs, fun ([Int, _, _]) -> - case t_number_vals(Int) of + case t_number_vals(Int, Opaques) of [N] when is_integer(N), N >= 0 -> t_tuple(N); _Other -> t_tuple() end - end); -type(erlang, memory, 0, _) -> t_list(t_tuple([t_atom(), t_non_neg_fixnum()])); -type(erlang, nif_error, 1, _) -> - t_any(); % this BIF and the next one are stubs for NIFs and never return -type(erlang, nif_error, 2, Xs) -> - strict(arg_types(erlang, nif_error, 2), Xs, fun (_) -> t_any() end); + end, Opaques); +type(erlang, nif_error, 1, Xs, Opaques) -> + %% this BIF and the next one are stubs for NIFs and never return + strict(erlang, nif_error, 1, Xs, fun (_) -> t_any() end, Opaques); +type(erlang, nif_error, 2, Xs, Opaques) -> + strict(erlang, nif_error, 2, Xs, fun (_) -> t_any() end, Opaques); %% Guard bif, needs to be here. -type(erlang, node, 0, _) -> t_node(); +type(erlang, node, 0, _, _Opaques) -> t_node(); %% Guard bif, needs to be here. -type(erlang, node, 1, Xs) -> - strict(arg_types(erlang, node, 1), Xs, fun (_) -> t_node() end); +type(erlang, node, 1, Xs, Opaques) -> + strict(erlang, node, 1, Xs, fun (_) -> t_node() end, Opaques); %% Guard bif, needs to be here. -type(erlang, round, 1, Xs) -> - strict(arg_types(erlang, round, 1), Xs, fun (_) -> t_integer() end); +type(erlang, round, 1, Xs, Opaques) -> + strict(erlang, round, 1, Xs, fun (_) -> t_integer() end, Opaques); %% Guard bif, needs to be here. -type(erlang, self, 0, _) -> t_pid(); -type(erlang, set_cookie, 2, Xs) -> - strict(arg_types(erlang, set_cookie, 2), Xs, fun (_) -> t_atom('true') end); -type(erlang, setelement, 3, Xs) -> - strict(arg_types(erlang, setelement, 3), Xs, +type(erlang, self, 0, _, _Opaques) -> t_pid(); +type(erlang, setelement, 3, Xs, Opaques) -> + strict(erlang, setelement, 3, Xs, fun ([X1, X2, X3]) -> - case t_tuple_subtypes(X2) of + case t_tuple_subtypes(X2, Opaques) of unknown -> t_tuple(); [_] -> - Sz = t_tuple_size(X2), - As = t_tuple_args(X2), - case t_number_vals(X1) of + Sz = t_tuple_size(X2, Opaques), + As = t_tuple_args(X2, Opaques), + case t_number_vals(X1, Opaques) of unknown -> t_tuple([t_sup(X, X3) || X <- As]); [N] when is_integer(N), 1 =< N, N =< Sz -> @@ -799,29 +838,17 @@ type(erlang, setelement, 3, Xs) -> Ts when is_list(Ts) -> t_sup([type(erlang, setelement, 3, [X1, Y, X3]) || Y <- Ts]) end - end); + end, Opaques); %% Guard bif, needs to be here. -type(erlang, size, 1, Xs) -> - strict(arg_types(erlang, size, 1), Xs, fun (_) -> t_non_neg_integer() end); -type(erlang, spawn, 1, Xs) -> - strict(arg_types(erlang, spawn, 1), Xs, fun (_) -> t_pid() end); -type(erlang, spawn, 2, Xs) -> - strict(arg_types(erlang, spawn, 2), Xs, fun (_) -> t_pid() end); -type(erlang, spawn, 4, Xs) -> - strict(arg_types(erlang, spawn, 4), Xs, fun (_) -> t_pid() end); -type(erlang, spawn_link, 1, Xs) -> type(erlang, spawn, 1, Xs); % same -type(erlang, spawn_link, 2, Xs) -> type(erlang, spawn, 2, Xs); % same -type(erlang, spawn_link, 4, Xs) -> type(erlang, spawn, 4, Xs); % same -type(erlang, subtract, 2, Xs) -> type(erlang, '--', 2, Xs); % alias -type(erlang, suspend_process, 1, Xs) -> - strict(arg_types(erlang, suspend_process, 1), Xs, - fun (_) -> t_atom('true') end); -type(erlang, system_info, 1, Xs) -> - strict(arg_types(erlang, system_info, 1), Xs, +type(erlang, size, 1, Xs, Opaques) -> + strict(erlang, size, 1, Xs, fun (_) -> t_non_neg_integer() end, Opaques); +type(erlang, subtract, 2, Xs, _Opaques) -> type(erlang, '--', 2, Xs); % alias +type(erlang, system_info, 1, Xs, Opaques) -> + strict(erlang, system_info, 1, Xs, fun ([Type]) -> - case t_is_atom(Type) of + case t_is_atom(Type, Opaques) of true -> - case t_atom_vals(Type) of + case t_atom_vals(Type, Opaques) of ['allocated_areas'] -> t_list(t_sup([t_tuple([t_atom(),t_non_neg_integer()]), t_tuple([t_atom(), @@ -936,26 +963,28 @@ type(erlang, system_info, 1, Xs) -> false -> %% This currently handles only {allocator, Alloc} t_any() %% overapproximation as the return value might change end - end); + end, Opaques); %% Guard bif, needs to be here. -type(erlang, tl, 1, Xs) -> - strict(arg_types(erlang, tl, 1), Xs, fun ([X]) -> t_cons_tl(X) end); +type(erlang, tl, 1, Xs, Opaques) -> + strict(erlang, tl, 1, Xs, fun ([X]) -> t_cons_tl(X) end, Opaques); %% Guard bif, needs to be here. -type(erlang, trunc, 1, Xs) -> - strict(arg_types(erlang, trunc, 1), Xs, fun (_) -> t_integer() end); +type(erlang, trunc, 1, Xs, Opaques) -> + strict(erlang, trunc, 1, Xs, fun (_) -> t_integer() end, Opaques); %% Guard bif, needs to be here. -type(erlang, tuple_size, 1, Xs) -> - strict(arg_types(erlang, tuple_size, 1), Xs, fun (_) -> t_non_neg_integer() end); -type(erlang, tuple_to_list, 1, Xs) -> - strict(arg_types(erlang, tuple_to_list, 1), Xs, +type(erlang, tuple_size, 1, Xs, Opaques) -> + strict(erlang, tuple_size, 1, Xs, + fun (_) -> t_non_neg_integer() end, Opaques); +type(erlang, tuple_to_list, 1, Xs, Opaques) -> + strict(erlang, tuple_to_list, 1, Xs, fun ([X]) -> - case t_tuple_subtypes(X) of + case t_tuple_subtypes(X, Opaques) of unknown -> t_list(); SubTypes -> - Args = lists:flatten([t_tuple_args(ST) || ST <- SubTypes]), + Args = lists:append([t_tuple_args(ST, Opaques) || + ST <- SubTypes]), %% Can be nil if the tuple can be {} case lists:any(fun (T) -> - t_tuple_size(T) =:= 0 + t_tuple_size(T, Opaques) =:= 0 end, SubTypes) of true -> %% Be careful here. If we had only {} we need to @@ -965,279 +994,277 @@ type(erlang, tuple_to_list, 1, Xs) -> t_nonempty_list(t_sup(Args)) end end - end); -type(erlang, yield, 0, _) -> t_atom('true'); -%%-- ets ---------------------------------------------------------------------- -type(ets, rename, 2, Xs) -> - strict(arg_types(ets, rename, 2), Xs, fun ([_, Name]) -> Name end); + end, Opaques); %%-- hipe_bifs ---------------------------------------------------------------- -type(hipe_bifs, add_ref, 2, Xs) -> - strict(arg_types(hipe_bifs, add_ref, 2), Xs, fun (_) -> t_nil() end); -type(hipe_bifs, alloc_data, 2, Xs) -> - strict(arg_types(hipe_bifs, alloc_data, 2), Xs, - fun (_) -> t_integer() end); % address -type(hipe_bifs, array, 2, Xs) -> - strict(arg_types(hipe_bifs, array, 2), Xs, fun (_) -> t_immarray() end); -type(hipe_bifs, array_length, 1, Xs) -> - strict(arg_types(hipe_bifs, array_length, 1), Xs, - fun (_) -> t_non_neg_fixnum() end); -type(hipe_bifs, array_sub, 2, Xs) -> - strict(arg_types(hipe_bifs, array_sub, 2), Xs, fun (_) -> t_immediate() end); -type(hipe_bifs, array_update, 3, Xs) -> - strict(arg_types(hipe_bifs, array_update, 3), Xs, - fun (_) -> t_immarray() end); -type(hipe_bifs, atom_to_word, 1, Xs) -> - strict(arg_types(hipe_bifs, atom_to_word, 1), Xs, - fun (_) -> t_integer() end); -type(hipe_bifs, bif_address, 3, Xs) -> - strict(arg_types(hipe_bifs, bif_address, 3), Xs, - fun (_) -> t_sup(t_integer(), t_atom('false')) end); -type(hipe_bifs, bitarray, 2, Xs) -> - strict(arg_types(hipe_bifs, bitarray, 2), Xs, fun (_) -> t_bitarray() end); -type(hipe_bifs, bitarray_sub, 2, Xs) -> - strict(arg_types(hipe_bifs, bitarray_sub, 2), Xs, fun (_) -> t_boolean() end); -type(hipe_bifs, bitarray_update, 3, Xs) -> - strict(arg_types(hipe_bifs, bitarray_update, 3), Xs, - fun (_) -> t_bitarray() end); -type(hipe_bifs, bytearray, 2, Xs) -> - strict(arg_types(hipe_bifs, bytearray, 2), Xs, fun (_) -> t_bytearray() end); -type(hipe_bifs, bytearray_sub, 2, Xs) -> - strict(arg_types(hipe_bifs, bytearray_sub, 2), Xs, fun (_) -> t_byte() end); -type(hipe_bifs, bytearray_update, 3, Xs) -> - strict(arg_types(hipe_bifs, bytearray_update, 3), Xs, - fun (_) -> t_bytearray() end); -type(hipe_bifs, call_count_clear, 1, Xs) -> - strict(arg_types(hipe_bifs, call_count_clear, 1), Xs, - fun (_) -> t_sup(t_non_neg_integer(), t_atom('false')) end); -type(hipe_bifs, call_count_get, 1, Xs) -> - strict(arg_types(hipe_bifs, call_count_get, 1), Xs, - fun (_) -> t_sup(t_non_neg_integer(), t_atom('false')) end); -type(hipe_bifs, call_count_off, 1, Xs) -> - strict(arg_types(hipe_bifs, call_count_off, 1), Xs, - fun (_) -> t_sup(t_non_neg_integer(), t_atom('false')) end); -type(hipe_bifs, call_count_on, 1, Xs) -> - strict(arg_types(hipe_bifs, call_count_on, 1), Xs, - fun (_) -> t_sup(t_atom('true'), t_nil()) end); -type(hipe_bifs, check_crc, 1, Xs) -> - strict(arg_types(hipe_bifs, check_crc, 1), Xs, fun (_) -> t_boolean() end); -type(hipe_bifs, enter_code, 2, Xs) -> - strict(arg_types(hipe_bifs, enter_code, 2), Xs, +type(hipe_bifs, add_ref, 2, Xs, Opaques) -> + strict(hipe_bifs, add_ref, 2, Xs, fun (_) -> t_nil() end, Opaques); +type(hipe_bifs, alloc_data, 2, Xs, Opaques) -> + strict(hipe_bifs, alloc_data, 2, Xs, + fun (_) -> t_integer() end, Opaques); % address +type(hipe_bifs, array, 2, Xs, Opaques) -> + strict(hipe_bifs, array, 2, Xs, fun (_) -> t_immarray() end, Opaques); +type(hipe_bifs, array_length, 1, Xs, Opaques) -> + strict(hipe_bifs, array_length, 1, Xs, + fun (_) -> t_non_neg_fixnum() end, Opaques); +type(hipe_bifs, array_sub, 2, Xs, Opaques) -> + strict(hipe_bifs, array_sub, 2, Xs, fun (_) -> t_immediate() end, Opaques); +type(hipe_bifs, array_update, 3, Xs, Opaques) -> + strict(hipe_bifs, array_update, 3, Xs, + fun (_) -> t_immarray() end, Opaques); +type(hipe_bifs, atom_to_word, 1, Xs, Opaques) -> + strict(hipe_bifs, atom_to_word, 1, Xs, + fun (_) -> t_integer() end, Opaques); +type(hipe_bifs, bif_address, 3, Xs, Opaques) -> + strict(hipe_bifs, bif_address, 3, Xs, + fun (_) -> t_sup(t_integer(), t_atom('false')) end, Opaques); +type(hipe_bifs, bitarray, 2, Xs, Opaques) -> + strict(hipe_bifs, bitarray, 2, Xs, fun (_) -> t_bitarray() end, Opaques); +type(hipe_bifs, bitarray_sub, 2, Xs, Opaques) -> + strict(hipe_bifs, bitarray_sub, 2, Xs, + fun (_) -> t_boolean() end, Opaques); +type(hipe_bifs, bitarray_update, 3, Xs, Opaques) -> + strict(hipe_bifs, bitarray_update, 3, Xs, + fun (_) -> t_bitarray() end, Opaques); +type(hipe_bifs, bytearray, 2, Xs, Opaques) -> + strict(hipe_bifs, bytearray, 2, Xs, fun (_) -> t_bytearray() end, Opaques); +type(hipe_bifs, bytearray_sub, 2, Xs, Opaques) -> + strict(hipe_bifs, bytearray_sub, 2, Xs, fun (_) -> t_byte() end, Opaques); +type(hipe_bifs, bytearray_update, 3, Xs, Opaques) -> + strict(hipe_bifs, bytearray_update, 3, Xs, + fun (_) -> t_bytearray() end, Opaques); +type(hipe_bifs, call_count_clear, 1, Xs, Opaques) -> + strict(hipe_bifs, call_count_clear, 1, Xs, + fun (_) -> t_sup(t_non_neg_integer(), t_atom('false')) end, Opaques); +type(hipe_bifs, call_count_get, 1, Xs, Opaques) -> + strict(hipe_bifs, call_count_get, 1, Xs, + fun (_) -> t_sup(t_non_neg_integer(), t_atom('false')) end, Opaques); +type(hipe_bifs, call_count_off, 1, Xs, Opaques) -> + strict(hipe_bifs, call_count_off, 1, Xs, + fun (_) -> t_sup(t_non_neg_integer(), t_atom('false')) end, Opaques); +type(hipe_bifs, call_count_on, 1, Xs, Opaques) -> + strict(hipe_bifs, call_count_on, 1, Xs, + fun (_) -> t_sup(t_atom('true'), t_nil()) end, Opaques); +type(hipe_bifs, check_crc, 1, Xs, Opaques) -> + strict(hipe_bifs, check_crc, 1, Xs, fun (_) -> t_boolean() end, Opaques); +type(hipe_bifs, enter_code, 2, Xs, Opaques) -> + strict(hipe_bifs, enter_code, 2, Xs, fun (_) -> t_tuple([t_integer(), %% XXX: The tuple below contains integers and %% is of size same as the length of the MFA list - t_sup(t_nil(), t_binary())]) end); -type(hipe_bifs, enter_sdesc, 1, Xs) -> - strict(arg_types(hipe_bifs, enter_sdesc, 1), Xs, fun (_) -> t_nil() end); -type(hipe_bifs, find_na_or_make_stub, 2, Xs) -> - strict(arg_types(hipe_bifs, find_na_or_make_stub, 2), Xs, - fun (_) -> t_integer() end); % address -type(hipe_bifs, fun_to_address, 1, Xs) -> - strict(arg_types(hipe_bifs, fun_to_address, 1), Xs, - fun (_) -> t_integer() end); -%% type(hipe_bifs, get_emu_address, 1, Xs) -> -%% strict(arg_types(hipe_bifs, get_emu_address, 1), Xs, -%% fun (_) -> t_integer() end); % address -type(hipe_bifs, get_rts_param, 1, Xs) -> - strict(arg_types(hipe_bifs, get_rts_param, 1), Xs, - fun (_) -> t_sup(t_integer(), t_nil()) end); -type(hipe_bifs, invalidate_funinfo_native_addresses, 1, Xs) -> - strict(arg_types(hipe_bifs, invalidate_funinfo_native_addresses, 1), Xs, - fun (_) -> t_nil() end); -type(hipe_bifs, make_fe, 3, Xs) -> - strict(arg_types(hipe_bifs, make_fe, 3), Xs, fun (_) -> t_integer() end); -%% type(hipe_bifs, make_native_stub, 2, Xs) -> -%% strict(arg_types(hipe_bifs, make_native_stub, 2), Xs, -%% fun (_) -> t_integer() end); % address -type(hipe_bifs, mark_referred_from, 1, Xs) -> - strict(arg_types(hipe_bifs, mark_referred_from, 1), Xs, - fun (_) -> t_nil() end); -type(hipe_bifs, merge_term, 1, Xs) -> - strict(arg_types(hipe_bifs, merge_term, 1), Xs, fun ([X]) -> X end); -type(hipe_bifs, nstack_used_size, 0, _) -> + t_sup(t_nil(), t_binary())]) end, Opaques); +type(hipe_bifs, enter_sdesc, 1, Xs, Opaques) -> + strict(hipe_bifs, enter_sdesc, 1, Xs, fun (_) -> t_nil() end, Opaques); +type(hipe_bifs, find_na_or_make_stub, 2, Xs, Opaques) -> + strict(hipe_bifs, find_na_or_make_stub, 2, Xs, + fun (_) -> t_integer() end, Opaques); % address +type(hipe_bifs, fun_to_address, 1, Xs, Opaques) -> + strict(hipe_bifs, fun_to_address, 1, Xs, + fun (_) -> t_integer() end, Opaques); +type(hipe_bifs, get_fe, 2, Xs, Opaques) -> + strict(hipe_bifs, get_fe, 2, Xs, fun (_) -> t_integer() end, Opaques); +type(hipe_bifs, get_rts_param, 1, Xs, Opaques) -> + strict(hipe_bifs, get_rts_param, 1, Xs, + fun (_) -> t_sup(t_integer(), t_nil()) end, Opaques); +type(hipe_bifs, invalidate_funinfo_native_addresses, 1, Xs, Opaques) -> + strict(hipe_bifs, invalidate_funinfo_native_addresses, 1, Xs, + fun (_) -> t_nil() end, Opaques); +type(hipe_bifs, mark_referred_from, 1, Xs, Opaques) -> + strict(hipe_bifs, mark_referred_from, 1, Xs, + fun (_) -> t_nil() end, Opaques); +type(hipe_bifs, merge_term, 1, Xs, Opaques) -> + strict(hipe_bifs, merge_term, 1, Xs, fun ([X]) -> X end, Opaques); +type(hipe_bifs, nstack_used_size, 0, _, _Opaques) -> t_non_neg_fixnum(); -type(hipe_bifs, patch_call, 3, Xs) -> - strict(arg_types(hipe_bifs, patch_call, 3), Xs, fun (_) -> t_nil() end); -type(hipe_bifs, patch_insn, 3, Xs) -> - strict(arg_types(hipe_bifs, patch_insn, 3), Xs, fun (_) -> t_nil() end); -type(hipe_bifs, primop_address, 1, Xs) -> - strict(arg_types(hipe_bifs, primop_address, 1), Xs, - fun (_) -> t_sup(t_integer(), t_atom('false')) end); -type(hipe_bifs, redirect_referred_from, 1, Xs) -> - strict(arg_types(hipe_bifs, redirect_referred_from, 1), Xs, - fun (_) -> t_nil() end); -type(hipe_bifs, ref, 1, Xs) -> - strict(arg_types(hipe_bifs, ref, 1), Xs, fun (_) -> t_immarray() end); -type(hipe_bifs, ref_get, 1, Xs) -> - strict(arg_types(hipe_bifs, ref_get, 1), Xs, fun (_) -> t_immediate() end); -type(hipe_bifs, ref_set, 2, Xs) -> - strict(arg_types(hipe_bifs, ref_set, 2), Xs, fun (_) -> t_nil() end); -type(hipe_bifs, remove_refs_from, 1, Xs) -> - strict(arg_types(hipe_bifs, remove_refs_from, 1), Xs, - fun (_) -> t_atom('ok') end); -type(hipe_bifs, set_funinfo_native_address, 3, Xs) -> - strict(arg_types(hipe_bifs, set_funinfo_native_address, 3), Xs, - fun (_) -> t_nil() end); -type(hipe_bifs, set_native_address, 3, Xs) -> - strict(arg_types(hipe_bifs, set_native_address, 3), Xs, - fun (_) -> t_nil() end); -type(hipe_bifs, system_crc, 1, Xs) -> - strict(arg_types(hipe_bifs, system_crc, 1), Xs, fun (_) -> t_crc32() end); -type(hipe_bifs, term_to_word, 1, Xs) -> - strict(arg_types(hipe_bifs, term_to_word, 1), Xs, - fun (_) -> t_integer() end); -type(hipe_bifs, update_code_size, 3, Xs) -> - strict(arg_types(hipe_bifs, update_code_size, 3), Xs, - fun (_) -> t_nil() end); -type(hipe_bifs, write_u8, 2, Xs) -> - strict(arg_types(hipe_bifs, write_u8, 2), Xs, fun (_) -> t_nil() end); -type(hipe_bifs, write_u32, 2, Xs) -> - strict(arg_types(hipe_bifs, write_u32, 2), Xs, fun (_) -> t_nil() end); -type(hipe_bifs, write_u64, 2, Xs) -> - strict(arg_types(hipe_bifs, write_u64, 2), Xs, fun (_) -> t_nil() end); +type(hipe_bifs, patch_call, 3, Xs, Opaques) -> + strict(hipe_bifs, patch_call, 3, Xs, fun (_) -> t_nil() end, Opaques); +type(hipe_bifs, patch_insn, 3, Xs, Opaques) -> + strict(hipe_bifs, patch_insn, 3, Xs, fun (_) -> t_nil() end, Opaques); +type(hipe_bifs, primop_address, 1, Xs, Opaques) -> + strict(hipe_bifs, primop_address, 1, Xs, + fun (_) -> t_sup(t_integer(), t_atom('false')) end, Opaques); +type(hipe_bifs, redirect_referred_from, 1, Xs, Opaques) -> + strict(hipe_bifs, redirect_referred_from, 1, Xs, + fun (_) -> t_nil() end, Opaques); +type(hipe_bifs, ref, 1, Xs, Opaques) -> + strict(hipe_bifs, ref, 1, Xs, fun (_) -> t_immarray() end, Opaques); +type(hipe_bifs, ref_get, 1, Xs, Opaques) -> + strict(hipe_bifs, ref_get, 1, Xs, fun (_) -> t_immediate() end, Opaques); +type(hipe_bifs, ref_set, 2, Xs, Opaques) -> + strict(hipe_bifs, ref_set, 2, Xs, fun (_) -> t_nil() end, Opaques); +type(hipe_bifs, remove_refs_from, 1, Xs, Opaques) -> + strict(hipe_bifs, remove_refs_from, 1, Xs, + fun (_) -> t_atom('ok') end, Opaques); +type(hipe_bifs, set_funinfo_native_address, 3, Xs, Opaques) -> + strict(hipe_bifs, set_funinfo_native_address, 3, Xs, + fun (_) -> t_nil() end, Opaques); +type(hipe_bifs, set_native_address, 3, Xs, Opaques) -> + strict(hipe_bifs, set_native_address, 3, Xs, + fun (_) -> t_nil() end, Opaques); +type(hipe_bifs, set_native_address_in_fe, 2, Xs, Opaques) -> + strict(hipe_bifs, set_native_address_in_fe, 2, Xs, + fun (_) -> t_atom('true') end, Opaques); +type(hipe_bifs, system_crc, 0, _, _Opaques) -> + t_crc32(); +type(hipe_bifs, term_to_word, 1, Xs, Opaques) -> + strict(hipe_bifs, term_to_word, 1, Xs, + fun (_) -> t_integer() end, Opaques); +type(hipe_bifs, update_code_size, 3, Xs, Opaques) -> + strict(hipe_bifs, update_code_size, 3, Xs, + fun (_) -> t_nil() end, Opaques); +type(hipe_bifs, write_u8, 2, Xs, Opaques) -> + strict(hipe_bifs, write_u8, 2, Xs, fun (_) -> t_nil() end, Opaques); +type(hipe_bifs, write_u32, 2, Xs, Opaques) -> + strict(hipe_bifs, write_u32, 2, Xs, fun (_) -> t_nil() end, Opaques); +type(hipe_bifs, write_u64, 2, Xs, Opaques) -> + strict(hipe_bifs, write_u64, 2, Xs, fun (_) -> t_nil() end, Opaques); %%-- lists -------------------------------------------------------------------- -type(lists, all, 2, Xs) -> - strict(arg_types(lists, all, 2), Xs, +type(lists, all, 2, Xs, Opaques) -> + strict(lists, all, 2, Xs, fun ([F, L]) -> - case t_is_nil(L) of + case t_is_nil(L, Opaques) of true -> t_atom('true'); false -> - El = t_list_elements(L), - case check_fun_application(F, [El]) of + El = t_list_elements(L, Opaques), + case check_fun_application(F, [El], Opaques) of ok -> - case t_is_cons(L) of - true -> t_fun_range(F); + case t_is_cons(L, Opaques) of + true -> t_fun_range(F, Opaques); false -> %% The list can be empty. - t_sup(t_atom('true'), t_fun_range(F)) + t_sup(t_atom('true'), t_fun_range(F, Opaques)) end; error -> - case t_is_cons(L) of + case t_is_cons(L, Opaques) of true -> t_none(); - false -> t_fun_range(F) + false -> t_fun_range(F, Opaques) end end end - end); -type(lists, any, 2, Xs) -> - strict(arg_types(lists, any, 2), Xs, + end, Opaques); +type(lists, any, 2, Xs, Opaques) -> + strict(lists, any, 2, Xs, fun ([F, L]) -> - case t_is_nil(L) of + case t_is_nil(L, Opaques) of true -> t_atom('false'); false -> - El = t_list_elements(L), - case check_fun_application(F, [El]) of + El = t_list_elements(L, Opaques), + case check_fun_application(F, [El], Opaques) of ok -> - case t_is_cons(L) of - true -> t_fun_range(F); + case t_is_cons(L, Opaques) of + true -> t_fun_range(F, Opaques); false -> %% The list can be empty - t_sup(t_atom('false'), t_fun_range(F)) + t_sup(t_atom('false'), t_fun_range(F, Opaques)) end; error -> - case t_is_cons(L) of + case t_is_cons(L, Opaques) of true -> t_none(); - false -> t_fun_range(F) + false -> t_fun_range(F, Opaques) end end end - end); -type(lists, append, 2, Xs) -> type(erlang, '++', 2, Xs); % alias -type(lists, delete, 2, Xs) -> - strict(arg_types(lists, delete, 2), Xs, + end, Opaques); +type(lists, append, 2, Xs, _Opaques) -> type(erlang, '++', 2, Xs); % alias +type(lists, delete, 2, Xs, Opaques) -> + strict(lists, delete, 2, Xs, fun ([_, List]) -> - case t_is_cons(List) of + case t_is_cons(List, Opaques) of true -> t_cons_tl(List); false -> List end - end); -type(lists, dropwhile, 2, Xs) -> - strict(arg_types(lists, dropwhile, 2), Xs, + end, Opaques); +type(lists, dropwhile, 2, Xs, Opaques) -> + strict(lists, dropwhile, 2, Xs, fun ([F, X]) -> - case t_is_nil(X) of + case t_is_nil(X, Opaques) of true -> t_nil(); false -> - X1 = t_list_elements(X), - case check_fun_application(F, [X1]) of + X1 = t_list_elements(X, Opaques), + case check_fun_application(F, [X1], Opaques) of ok -> - case t_atom_vals(t_fun_range(F)) of + case t_atom_vals(t_fun_range(F, Opaques), Opaques) of ['true'] -> - case t_is_none(t_inf(t_list(), X)) of + case t_is_none(t_inf(t_list(), X, Opaques)) of true -> t_none(); false -> t_nil() end; ['false'] -> - case t_is_none(t_inf(t_list(), X)) of + case t_is_none(t_inf(t_list(), X, Opaques)) of true -> t_none(); false -> X end; _ -> - t_inf(t_cons_tl(t_inf(X, t_cons())), - t_maybe_improper_list()) + t_inf(t_cons_tl(t_inf(X, t_cons(), Opaques)), + t_maybe_improper_list(), Opaques) end; error -> - case t_is_cons(X) of + case t_is_cons(X, Opaques) of true -> t_none(); false -> t_nil() end end end - end); -type(lists, filter, 2, Xs) -> - strict(arg_types(lists, filter, 2), Xs, + end, Opaques); +type(lists, filter, 2, Xs, Opaques) -> + strict(lists, filter, 2, Xs, fun ([F, L]) -> - case t_is_nil(L) of + case t_is_nil(L, Opaques) of true -> t_nil(); false -> - T = t_list_elements(L), - case check_fun_application(F, [T]) of + T = t_list_elements(L, Opaques), + case check_fun_application(F, [T], Opaques) of ok -> - case t_atom_vals(t_fun_range(F)) =:= ['false'] of + RangeVals = t_atom_vals(t_fun_range(F, Opaques), Opaques), + case RangeVals =:= ['false'] of true -> t_nil(); false -> - case t_atom_vals(t_fun_range(F)) =:= ['true'] of + case RangeVals =:= ['true'] of true -> L; false -> t_list(T) end end; error -> - case t_is_cons(L) of + case t_is_cons(L, Opaques) of true -> t_none(); false -> t_nil() end end end - end); -type(lists, flatten, 1, Xs) -> - strict(arg_types(lists, flatten, 1), Xs, + end, Opaques); +type(lists, flatten, 1, Xs, Opaques) -> + strict(lists, flatten, 1, Xs, fun ([L]) -> - case t_is_nil(L) of + case t_is_nil(L, Opaques) of true -> L; % (nil has undefined elements) false -> %% Avoiding infinite recursion is tricky - X1 = t_list_elements(L), + X1 = t_list_elements(L, Opaques), case t_is_any(X1) of true -> t_list(); false -> - X2 = type(lists, flatten, 1, [t_inf(X1, t_list())]), + X2 = type(lists, flatten, 1, [t_inf(X1, t_list(), Opaques)]), t_sup(t_list(t_subtract(X1, t_list())), X2) end end - end); -type(lists, flatmap, 2, Xs) -> - strict(arg_types(lists, flatmap, 2), Xs, + end, Opaques); +type(lists, flatmap, 2, Xs, Opaques) -> + strict(lists, flatmap, 2, Xs, fun ([F, List]) -> - case t_is_nil(List) of + case t_is_nil(List, Opaques) of true -> t_nil(); false -> - case check_fun_application(F, [t_list_elements(List)]) of + case + check_fun_application(F, [t_list_elements(List, Opaques)], + Opaques) + of ok -> - R = t_fun_range(F), + R = t_fun_range(F, Opaques), case t_is_nil(R) of true -> t_nil(); false -> - Elems = t_list_elements(R), - case t_is_cons(List) of + Elems = t_list_elements(R, Opaques), + case t_is_cons(List, Opaques) of true -> case t_is_subtype(t_nil(), R) of true -> t_list(Elems); @@ -1247,58 +1274,65 @@ type(lists, flatmap, 2, Xs) -> end end; error -> - case t_is_cons(List) of + case t_is_cons(List, Opaques) of true -> t_none(); false -> t_nil() end end end - end); -type(lists, foreach, 2, Xs) -> - strict(arg_types(lists, foreach, 2), Xs, + end, Opaques); +type(lists, foreach, 2, Xs, Opaques) -> + strict(lists, foreach, 2, Xs, fun ([F, List]) -> - case t_is_cons(List) of + case t_is_cons(List, Opaques) of true -> - case check_fun_application(F, [t_list_elements(List)]) of + case + check_fun_application(F, [t_list_elements(List, Opaques)], + Opaques) + of ok -> t_atom('ok'); error -> t_none() end; false -> t_atom('ok') end - end); -type(lists, foldl, 3, Xs) -> - strict(arg_types(lists, foldl, 3), Xs, + end, Opaques); +type(lists, foldl, 3, Xs, Opaques) -> + strict(lists, foldl, 3, Xs, fun ([F, Acc, List]) -> - case t_is_nil(List) of + case t_is_nil(List, Opaques) of true -> Acc; false -> - case check_fun_application(F, [t_list_elements(List), Acc]) of + case + check_fun_application(F, + [t_list_elements(List, Opaques),Acc], + Opaques) + of ok -> - case t_is_cons(List) of - true -> t_fun_range(F); - false -> t_sup(t_fun_range(F), Acc) + case t_is_cons(List, Opaques) of + true -> t_fun_range(F, Opaques); + false -> t_sup(t_fun_range(F, Opaques), Acc) end; error -> - case t_is_cons(List) of + case t_is_cons(List, Opaques) of true -> t_none(); false -> Acc end end end - end); -type(lists, foldr, 3, Xs) -> type(lists, foldl, 3, Xs); % same -type(lists, keydelete, 3, Xs) -> - strict(arg_types(lists, keydelete, 3), Xs, + end, Opaques); +type(lists, foldr, 3, Xs, _Opaques) -> type(lists, foldl, 3, Xs); % same +type(lists, keydelete, 3, Xs, Opaques) -> + strict(lists, keydelete, 3, Xs, fun ([_, _, L]) -> - Term = t_list_termination(L), - t_sup(Term, erl_types:lift_list_to_pos_empty(L)) - end); -type(lists, keyfind, 3, Xs) -> - strict(arg_types(lists, keyfind, 3), Xs, + Term = t_list_termination(L, Opaques), + t_sup(Term, erl_types:lift_list_to_pos_empty(L, Opaques)) + end, Opaques); +type(lists, keyfind, 3, Xs, Opaques) -> + strict(lists, keyfind, 3, Xs, fun ([X, Y, Z]) -> - ListEs = t_list_elements(Z), - Tuple = t_inf(t_tuple(), ListEs), + ListEs = t_list_elements(Z, Opaques), + Tuple = t_inf(t_tuple(), ListEs, Opaques), case t_is_none(Tuple) of true -> t_atom('false'); false -> @@ -1308,58 +1342,61 @@ type(lists, keyfind, 3, Xs) -> case t_is_any(X) of true -> Ret; false -> - case t_tuple_subtypes(Tuple) of + case t_tuple_subtypes(Tuple, Opaques) of unknown -> Ret; List -> - case key_comparisons_fail(X, Y, List) of + case key_comparisons_fail(X, Y, List, Opaques) of true -> t_atom('false'); false -> Ret end end end end - end); -type(lists, keymap, 3, Xs) -> - strict(arg_types(lists, keymap, 3), Xs, + end, Opaques); +type(lists, keymap, 3, Xs, Opaques) -> + strict(lists, keymap, 3, Xs, fun ([F, _I, L]) -> - case t_is_nil(L) of + case t_is_nil(L, Opaques) of true -> L; - false -> t_list(t_sup(t_fun_range(F), t_list_elements(L))) + false -> t_list(t_sup(t_fun_range(F, Opaques), + t_list_elements(L, Opaques))) end - end); -type(lists, keymember, 3, Xs) -> - strict(arg_types(lists, keymember, 3), Xs, + end, Opaques); +type(lists, keymember, 3, Xs, Opaques) -> + strict(lists, keymember, 3, Xs, fun ([X, Y, Z]) -> - ListEs = t_list_elements(Z), - Tuple = t_inf(t_tuple(), ListEs), + ListEs = t_list_elements(Z, Opaques), + Tuple = t_inf(t_tuple(), ListEs, Opaques), case t_is_none(Tuple) of true -> t_atom('false'); false -> case t_is_any(X) of true -> t_boolean(); false -> - case t_tuple_subtypes(Tuple) of + case t_tuple_subtypes(Tuple, Opaques) of unknown -> t_boolean(); List -> - case key_comparisons_fail(X, Y, List) of + case key_comparisons_fail(X, Y, List, Opaques) of true -> t_atom('false'); false -> t_boolean() end end end end - end); -type(lists, keymerge, 3, Xs) -> - strict(arg_types(lists, keymerge, 3), Xs, - fun ([_I, L1, L2]) -> type(lists, merge, 2, [L1, L2]) end); -type(lists, keyreplace, 4, Xs) -> - strict(arg_types(lists, keyreplace, 4), Xs, - fun ([_K, _I, L, T]) -> t_list(t_sup(t_list_elements(L), T)) end); -type(lists, keysearch, 3, Xs) -> - strict(arg_types(lists, keysearch, 3), Xs, + end, Opaques); +type(lists, keymerge, 3, Xs, Opaques) -> + strict(lists, keymerge, 3, Xs, + fun ([_I, L1, L2]) -> type(lists, merge, 2, [L1, L2]) end, Opaques); +type(lists, keyreplace, 4, Xs, Opaques) -> + strict(lists, keyreplace, 4, Xs, + fun ([_K, _I, L, T]) -> + t_list(t_sup(t_list_elements(L, Opaques), T)) + end, Opaques); +type(lists, keysearch, 3, Xs, Opaques) -> + strict(lists, keysearch, 3, Xs, fun ([X, Y, Z]) -> - ListEs = t_list_elements(Z), - Tuple = t_inf(t_tuple(), ListEs), + ListEs = t_list_elements(Z, Opaques), + Tuple = t_inf(t_tuple(), ListEs, Opaques), case t_is_none(Tuple) of true -> t_atom('false'); false -> @@ -1368,91 +1405,93 @@ type(lists, keysearch, 3, Xs) -> case t_is_any(X) of true -> Ret; false -> - case t_tuple_subtypes(Tuple) of + case t_tuple_subtypes(Tuple, Opaques) of unknown -> Ret; List -> - case key_comparisons_fail(X, Y, List) of + case key_comparisons_fail(X, Y, List, Opaques) of true -> t_atom('false'); false -> Ret end end end end - end); -type(lists, keysort, 2, Xs) -> - strict(arg_types(lists, keysort, 2), Xs, fun ([_, L]) -> L end); -type(lists, last, 1, Xs) -> - strict(arg_types(lists, last, 1), Xs, fun ([L]) -> t_list_elements(L) end); -type(lists, map, 2, Xs) -> - strict(arg_types(lists, map, 2), Xs, + end, Opaques); +type(lists, keysort, 2, Xs, Opaques) -> + strict(lists, keysort, 2, Xs, fun ([_, L]) -> L end, Opaques); +type(lists, last, 1, Xs, Opaques) -> + strict(lists, last, 1, Xs, + fun ([L]) -> t_list_elements(L, Opaques) end, Opaques); +type(lists, map, 2, Xs, Opaques) -> + strict(lists, map, 2, Xs, fun ([F, L]) -> - case t_is_nil(L) of + case t_is_nil(L, Opaques) of true -> L; false -> - El = t_list_elements(L), - case t_is_cons(L) of + El = t_list_elements(L, Opaques), + case t_is_cons(L, Opaques) of true -> - case check_fun_application(F, [El]) of - ok -> t_nonempty_list(t_fun_range(F)); + case check_fun_application(F, [El], Opaques) of + ok -> t_nonempty_list(t_fun_range(F, Opaques)); error -> t_none() end; false -> - case check_fun_application(F, [El]) of - ok -> t_list(t_fun_range(F)); + case check_fun_application(F, [El], Opaques) of + ok -> t_list(t_fun_range(F, Opaques)); error -> t_nil() end end end - end); -type(lists, mapfoldl, 3, Xs) -> - strict(arg_types(lists, mapfoldl, 3), Xs, + end, Opaques); +type(lists, mapfoldl, 3, Xs, Opaques) -> + strict(lists, mapfoldl, 3, Xs, fun ([F, Acc, List]) -> - case t_is_nil(List) of + case t_is_nil(List, Opaques) of true -> t_tuple([List, Acc]); false -> - El = t_list_elements(List), - R = t_fun_range(F), - case t_is_cons(List) of + El = t_list_elements(List, Opaques), + R = t_fun_range(F, Opaques), + case t_is_cons(List, Opaques) of true -> - case check_fun_application(F, [El, Acc]) of + case check_fun_application(F, [El, Acc], Opaques) of ok -> Fun = fun (RangeTuple) -> - [T1, T2] = t_tuple_args(RangeTuple), + [T1, T2] = t_tuple_args(RangeTuple, Opaques), t_tuple([t_nonempty_list(T1), T2]) end, - t_sup([Fun(ST) || ST <- t_tuple_subtypes(R)]); + t_sup([Fun(ST) || ST <- t_tuple_subtypes(R, Opaques)]); error -> t_none() end; false -> - case check_fun_application(F, [El, Acc]) of + case check_fun_application(F, [El, Acc], Opaques) of ok -> Fun = fun (RangeTuple) -> - [T1, T2] = t_tuple_args(RangeTuple), + [T1, T2] = t_tuple_args(RangeTuple, Opaques), t_tuple([t_list(T1), t_sup(Acc, T2)]) end, - t_sup([Fun(ST) || ST <- t_tuple_subtypes(R)]); + t_sup([Fun(ST) || ST <- t_tuple_subtypes(R, Opaques)]); error -> t_tuple([t_nil(), Acc]) end end end - end); -type(lists, mapfoldr, 3, Xs) -> type(lists, mapfoldl, 3, Xs); % same -type(lists, max, 1, Xs) -> - strict(arg_types(lists, max, 1), Xs, fun ([L]) -> t_list_elements(L) end); -type(lists, member, 2, Xs) -> - strict(arg_types(lists, member, 2), Xs, + end, Opaques); +type(lists, mapfoldr, 3, Xs, _Opaques) -> type(lists, mapfoldl, 3, Xs); % same +type(lists, max, 1, Xs, Opaques) -> + strict(lists, max, 1, Xs, + fun ([L]) -> t_list_elements(L, Opaques) end, Opaques); +type(lists, member, 2, Xs, Opaques) -> + strict(lists, member, 2, Xs, fun ([X, Y]) -> - Y1 = t_list_elements(Y), - case t_is_none(t_inf(Y1, X)) of + Y1 = t_list_elements(Y, Opaques), + case t_is_none(t_inf(Y1, X, Opaques)) of true -> t_atom('false'); false -> t_boolean() end - end); -%% type(lists, merge, 1, Xs) -> -type(lists, merge, 2, Xs) -> - strict(arg_types(lists, merge, 2), Xs, + end, Opaques); +%% type(lists, merge, 1, Xs, Opaques) -> +type(lists, merge, 2, Xs, Opaques) -> + strict(lists, merge, 2, Xs, fun ([L1, L2]) -> case t_is_none(L1) of true -> L2; @@ -1462,30 +1501,31 @@ type(lists, merge, 2, Xs) -> false -> t_sup(L1, L2) end end - end); -type(lists, min, 1, Xs) -> - strict(arg_types(lists, min, 1), Xs, fun ([L]) -> t_list_elements(L) end); -type(lists, nth, 2, Xs) -> - strict(arg_types(lists, nth, 2), Xs, - fun ([_, Y]) -> t_list_elements(Y) end); -type(lists, nthtail, 2, Xs) -> - strict(arg_types(lists, nthtail, 2), Xs, - fun ([_, Y]) -> t_sup(Y, t_list()) end); -type(lists, partition, 2, Xs) -> - strict(arg_types(lists, partition, 2), Xs, + end, Opaques); +type(lists, min, 1, Xs, Opaques) -> + strict(lists, min, 1, Xs, + fun ([L]) -> t_list_elements(L, Opaques) end, Opaques); +type(lists, nth, 2, Xs, Opaques) -> + strict(lists, nth, 2, Xs, + fun ([_, Y]) -> t_list_elements(Y, Opaques) end, Opaques); +type(lists, nthtail, 2, Xs, Opaques) -> + strict(lists, nthtail, 2, Xs, + fun ([_, Y]) -> t_sup(Y, t_list()) end, Opaques); +type(lists, partition, 2, Xs, Opaques) -> + strict(lists, partition, 2, Xs, fun ([F, L]) -> - case t_is_nil(L) of + case t_is_nil(L, Opaques) of true -> t_tuple([L,L]); false -> - El = t_list_elements(L), - case check_fun_application(F, [El]) of + El = t_list_elements(L, Opaques), + case check_fun_application(F, [El], Opaques) of error -> - case t_is_cons(L) of + case t_is_cons(L, Opaques) of true -> t_none(); false -> t_tuple([t_nil(), t_nil()]) end; ok -> - case t_atom_vals(t_fun_range(F)) of + case t_atom_vals(t_fun_range(F, Opaques), Opaques) of ['true'] -> t_tuple([L, t_nil()]); ['false'] -> t_tuple([t_nil(), L]); [_, _] -> @@ -1494,139 +1534,211 @@ type(lists, partition, 2, Xs) -> end end end - end); -type(lists, reverse, 1, Xs) -> - strict(arg_types(lists, reverse, 1), Xs, fun ([X]) -> X end); -type(lists, reverse, 2, Xs) -> + end, Opaques); +type(lists, reverse, 1, Xs, Opaques) -> + strict(lists, reverse, 1, Xs, fun ([X]) -> X end, Opaques); +type(lists, reverse, 2, Xs, _Opaques) -> type(erlang, '++', 2, Xs); % reverse-onto is just like append -type(lists, sort, 1, Xs) -> - strict(arg_types(lists, sort, 1), Xs, fun ([X]) -> X end); -type(lists, sort, 2, Xs) -> - strict(arg_types(lists, sort, 2), Xs, +type(lists, sort, 1, Xs, Opaques) -> + strict(lists, sort, 1, Xs, fun ([X]) -> X end, Opaques); +type(lists, sort, 2, Xs, Opaques) -> + strict(lists, sort, 2, Xs, fun ([F, L]) -> - R = t_fun_range(F), - case t_is_boolean(R) of + R = t_fun_range(F, Opaques), + case t_is_boolean(R, Opaques) of true -> L; false -> - case t_is_nil(L) of + case t_is_nil(L, Opaques) of true -> t_nil(); false -> t_none() end end - end); -type(lists, split, 2, Xs) -> - strict(arg_types(lists, split, 2), Xs, + end, Opaques); +type(lists, split, 2, Xs, Opaques) -> + strict(lists, split, 2, Xs, fun ([_, L]) -> - case t_is_nil(L) of + case t_is_nil(L, Opaques) of true -> t_tuple([L, L]); false -> - T = t_list_elements(L), + T = t_list_elements(L, Opaques), t_tuple([t_list(T), t_list(T)]) end - end); -type(lists, splitwith, 2, Xs) -> + end, Opaques); +type(lists, splitwith, 2, Xs, _Opaques) -> T1 = type(lists, takewhile, 2, Xs), T2 = type(lists, dropwhile, 2, Xs), case t_is_none(T1) orelse t_is_none(T2) of true -> t_none(); false -> t_tuple([T1, T2]) end; -type(lists, subtract, 2, Xs) -> type(erlang, '--', 2, Xs); % alias -type(lists, takewhile, 2, Xs) -> - strict(arg_types(lists, takewhile, 2), Xs, +type(lists, subtract, 2, Xs, _Opaques) -> type(erlang, '--', 2, Xs); % alias +type(lists, takewhile, 2, Xs, Opaques) -> + strict(lists, takewhile, 2, Xs, fun([F, L]) -> - case t_is_none(t_inf(t_list(), L)) of + case t_is_none(t_inf(t_list(), L, Opaques)) of false -> type(lists, filter, 2, Xs); true -> %% This works for non-proper lists as well. - El = t_list_elements(L), + El = t_list_elements(L, Opaques), type(lists, filter, 2, [F, t_list(El)]) end - end); -type(lists, usort, 1, Xs) -> type(lists, sort, 1, Xs); % same -type(lists, usort, 2, Xs) -> type(lists, sort, 2, Xs); % same -type(lists, unzip, 1, Xs) -> - strict(arg_types(lists, unzip, 1), Xs, + end, Opaques); +type(lists, usort, 1, Xs, _Opaques) -> type(lists, sort, 1, Xs); % same +type(lists, usort, 2, Xs, _Opaques) -> type(lists, sort, 2, Xs); % same +type(lists, unzip, 1, Xs, Opaques) -> + strict(lists, unzip, 1, Xs, fun ([Ps]) -> - case t_is_nil(Ps) of + case t_is_nil(Ps, Opaques) of true -> t_tuple([t_nil(), t_nil()]); false -> % Ps is a proper list of pairs - TupleTypes = t_tuple_subtypes(t_list_elements(Ps)), + TupleTypes = t_tuple_subtypes(t_list_elements(Ps, Opaques), + Opaques), lists:foldl(fun(Tuple, Acc) -> - [A, B] = t_tuple_args(Tuple), + [A, B] = t_tuple_args(Tuple, Opaques), t_sup(t_tuple([t_list(A), t_list(B)]), Acc) end, t_none(), TupleTypes) end - end); -type(lists, unzip3, 1, Xs) -> - strict(arg_types(lists, unzip3, 1), Xs, + end, Opaques); +type(lists, unzip3, 1, Xs, Opaques) -> + strict(lists, unzip3, 1, Xs, fun ([Ts]) -> - case t_is_nil(Ts) of + case t_is_nil(Ts, Opaques) of true -> t_tuple([t_nil(), t_nil(), t_nil()]); false -> % Ps is a proper list of triples - TupleTypes = t_tuple_subtypes(t_list_elements(Ts)), + TupleTypes = t_tuple_subtypes(t_list_elements(Ts, Opaques), + Opaques), lists:foldl(fun(T, Acc) -> - [A, B, C] = t_tuple_args(T), + [A, B, C] = t_tuple_args(T, Opaques), t_sup(t_tuple([t_list(A), t_list(B), t_list(C)]), Acc) end, t_none(), TupleTypes) end - end); -type(lists, zip, 2, Xs) -> - strict(arg_types(lists, zip, 2), Xs, + end, Opaques); +type(lists, zip, 2, Xs, Opaques) -> + strict(lists, zip, 2, Xs, fun ([As, Bs]) -> - case (t_is_nil(As) orelse t_is_nil(Bs)) of + case (t_is_nil(As, Opaques) orelse t_is_nil(Bs, Opaques)) of true -> t_nil(); false -> - A = t_list_elements(As), - B = t_list_elements(Bs), + A = t_list_elements(As, Opaques), + B = t_list_elements(Bs, Opaques), t_list(t_tuple([A, B])) end - end); -type(lists, zip3, 3, Xs) -> - strict(arg_types(lists, zip3, 3), Xs, + end, Opaques); +type(lists, zip3, 3, Xs, Opaques) -> + strict(lists, zip3, 3, Xs, fun ([As, Bs, Cs]) -> - case (t_is_nil(As) orelse t_is_nil(Bs) orelse t_is_nil(Cs)) of + case + (t_is_nil(As, Opaques) + orelse t_is_nil(Bs, Opaques) + orelse t_is_nil(Cs, Opaques)) + of true -> t_nil(); false -> - A = t_list_elements(As), - B = t_list_elements(Bs), - C = t_list_elements(Cs), + A = t_list_elements(As, Opaques), + B = t_list_elements(Bs, Opaques), + C = t_list_elements(Cs, Opaques), t_list(t_tuple([A, B, C])) end - end); -type(lists, zipwith, 3, Xs) -> - strict(arg_types(lists, zipwith, 3), Xs, - fun ([F, _As, _Bs]) -> t_sup(t_list(t_fun_range(F)), t_nil()) end); -type(lists, zipwith3, 4, Xs) -> - strict(arg_types(lists, zipwith3, 4), Xs, - fun ([F,_As,_Bs,_Cs]) -> t_sup(t_list(t_fun_range(F)), t_nil()) end); - -%%-- string ------------------------------------------------------------------- -type(string, chars, 2, Xs) -> % NOTE: added to avoid loss of information - strict(arg_types(string, chars, 2), Xs, fun (_) -> t_string() end); -type(string, chars, 3, Xs) -> % NOTE: added to avoid loss of information - strict(arg_types(string, chars, 3), Xs, - fun ([Char, N, Tail]) -> - case t_is_nil(Tail) of - true -> - type(string, chars, 2, [Char, N]); + end, Opaques); +type(lists, zipwith, 3, Xs, Opaques) -> + strict(lists, zipwith, 3, Xs, + fun ([F, _As, _Bs]) -> t_sup(t_list(t_fun_range(F, Opaques)), + t_nil()) end, Opaques); +type(lists, zipwith3, 4, Xs, Opaques) -> + strict(lists, zipwith3, 4, Xs, + fun ([F,_As,_Bs,_Cs]) -> t_sup(t_list(t_fun_range(F, Opaques)), + t_nil()) end, Opaques); + +%%-- maps --------------------------------------------------------------------- +type(maps, from_list, 1, Xs, Opaques) -> + strict(maps, from_list, 1, Xs, + fun ([List]) -> + case t_is_nil(List, Opaques) of + true -> t_from_term(#{}); false -> - case t_is_string(Tail) of - true -> - t_string(); - false -> - t_sup(t_sup(t_string(), Tail), t_cons(Char, Tail)) + T = t_list_elements(List, Opaques), + case t_tuple_subtypes(T, Opaques) of + unknown -> t_map(); + Stypes when length(Stypes) >= 1 -> + t_sup([begin + [K, V] = t_tuple_args(Args, Opaques), + t_map([], K, V) + end || Args <- Stypes]) end end - end); + end, Opaques); +type(maps, get, 2, Xs, Opaques) -> + strict(maps, get, 2, Xs, + fun ([Key, Map]) -> + t_map_get(Key, Map, Opaques) + end, Opaques); +type(maps, is_key, 2, Xs, Opaques) -> + strict(maps, is_key, 2, Xs, + fun ([Key, Map]) -> + t_map_is_key(Key, Map, Opaques) + end, Opaques); +type(maps, merge, 2, Xs, Opaques) -> + strict(maps, merge, 2, Xs, + fun ([MapA, MapB]) -> + ADefK = t_map_def_key(MapA, Opaques), + BDefK = t_map_def_key(MapB, Opaques), + ADefV = t_map_def_val(MapA, Opaques), + BDefV = t_map_def_val(MapB, Opaques), + t_map(map_pairwise_merge( + fun(K, _, _, mandatory, V) -> {K, mandatory, V}; + (K, MNess, VA, optional, VB) -> {K, MNess, t_sup(VA,VB)} + end, MapA, MapB), + t_sup(ADefK, BDefK), t_sup(ADefV, BDefV)) + end, Opaques); +type(maps, put, 3, Xs, Opaques) -> + strict(maps, put, 3, Xs, + fun ([Key, Value, Map]) -> + t_map_put({Key, Value}, Map, Opaques) + end, Opaques); +type(maps, size, 1, Xs, Opaques) -> + strict(maps, size, 1, Xs, + fun ([Map]) -> + Mand = [E || E={_,mandatory,_} <- t_map_entries(Map, Opaques)], + LowerBound = length(Mand), + case t_is_none(t_map_def_key(Map, Opaques)) of + false -> t_from_range(LowerBound, pos_inf); + true -> + Opt = [E || E={_,optional,_} <- t_map_entries(Map, Opaques)], + UpperBound = LowerBound + length(Opt), + t_from_range(LowerBound, UpperBound) + end + end, Opaques); +type(maps, to_list, 1, Xs, Opaques) -> + strict(maps, to_list, 1, Xs, + fun ([Map]) -> + DefK = t_map_def_key(Map, Opaques), + DefV = t_map_def_val(Map, Opaques), + Pairs = t_map_entries(Map, Opaques), + EType = lists:foldl( + fun({K,_,V},EType0) -> + case t_is_none(V) of + true -> t_subtract(EType0, t_tuple([K,t_any()])); + false -> t_sup(EType0, t_tuple([K,V])) + end + end, t_tuple([DefK, DefV]), Pairs), + case t_is_none(EType) of + true -> t_nil(); + false -> t_list(EType) + end + end, Opaques); +type(maps, update, 3, Xs, Opaques) -> + strict(maps, update, 3, Xs, + fun ([Key, Value, Map]) -> + t_map_update({Key, Value}, Map, Opaques) + end, Opaques); %%----------------------------------------------------------------------------- -type(M, F, A, Xs) when is_atom(M), is_atom(F), +type(M, F, A, Xs, _O) when is_atom(M), is_atom(F), is_integer(A), 0 =< A, A =< 255 -> strict(Xs, t_any()). % safe approximation for all functions. @@ -1635,13 +1747,20 @@ type(M, F, A, Xs) when is_atom(M), is_atom(F), %% Auxiliary functions %%----------------------------------------------------------------------------- -strict(Xs, Ts, F) -> - %% io:format("inf lists arg~n1:~p~n2:~p ~n", [Xs, Ts]), - Xs1 = inf_lists(Xs, Ts), +strict(M, F, A, Xs, Fun, Opaques) -> + Ts = arg_types(M, F, A), + %% io:format("inf lists arg~nXs: ~p~nTs: ~p ~n", [Xs, Ts]), + Xs1 = inf_lists(Xs, Ts, Opaques), %% io:format("inf lists return ~p ~n", [Xs1]), case any_is_none_or_unit(Xs1) of true -> t_none(); - false -> F(Xs1) + false -> Fun(Xs1) + end. + +strict2(Xs, X) -> + case any_is_none_or_unit(Xs) of + true -> t_none(); + false -> X end. strict(Xs, X) -> @@ -1650,9 +1769,9 @@ strict(Xs, X) -> false -> X end. -inf_lists([X | Xs], [T | Ts]) -> - [t_inf(X, T) | inf_lists(Xs, Ts)]; -inf_lists([], []) -> +inf_lists([X | Xs], [T | Ts], Opaques) -> + [t_inf(X, T, Opaques) | inf_lists(Xs, Ts, Opaques)]; +inf_lists([], [], _Opaques) -> []. any_list(N) -> any_list(N, t_any()). @@ -1670,20 +1789,43 @@ list_replace(1, E, [_X | Xs]) -> any_is_none_or_unit(Ts) -> lists:any(fun erl_types:t_is_none_or_unit/1, Ts). -check_guard([X], Test, Type) -> - check_guard_single(X, Test, Type). +check_guard([X], Test, Type, Opaques) -> + check_guard_single(X, Test, Type, Opaques). -check_guard_single(X, Test, Type) -> +check_guard_single(X, Test, Type, Opaques) -> case Test(X) of true -> t_atom('true'); false -> - case erl_types:t_is_opaque(X) of - true -> t_none(); - false -> - case t_is_none(t_inf(Type, X)) of - true -> t_atom('false'); - false -> t_boolean() - end + case t_is_none(t_inf(Type, X, Opaques)) of + true -> + case t_has_opaque_subtype(X, Opaques) of + true -> t_none(); + false -> t_atom('false') + end; + false -> t_boolean() + end + end. + +check_record_tag(Tag, Y, Opaques) -> + case t_is_atom(Tag, Opaques) of + false -> + TagAtom = t_inf(Tag, t_atom(), Opaques), + case t_is_none(TagAtom) of + true -> + case t_has_opaque_subtype(Tag, Opaques) of + true -> t_none(); + false -> t_atom('false') + end; + false -> t_boolean() + end; + true -> + case t_atom_vals(Tag, Opaques) of + [RealTag] -> + case t_atom_vals(Y, Opaques) of + [RealTag] -> t_atom('true'); + _ -> t_boolean() + end; + _ -> t_boolean() end end. @@ -1797,7 +1939,11 @@ infinity_add(neg_inf, _Number) -> neg_inf; infinity_add(_Number, pos_inf) -> pos_inf; infinity_add(_Number, neg_inf) -> neg_inf; infinity_add(Number1, Number2) when is_integer(Number1), is_integer(Number2) -> - Number1 + Number2. + try Number1 + Number2 + catch + error:system_limit when Number1 < 0 -> neg_inf; + error:system_limit -> pos_inf + end. infinity_mult(neg_inf, Number) -> Greater = infinity_geq(Number, 0), @@ -1808,7 +1954,13 @@ infinity_mult(pos_inf, Number) -> infinity_inv(infinity_mult(neg_inf, Number)); infinity_mult(Number, pos_inf) -> infinity_inv(infinity_mult(neg_inf, Number)); infinity_mult(Number, neg_inf) -> infinity_mult(neg_inf, Number); infinity_mult(Number1, Number2) when is_integer(Number1), is_integer(Number2)-> - Number1 * Number2. + try Number1 * Number2 + catch + error:system_limit -> + if (Number1 >= 0) =:= (Number2 >= 0) -> pos_inf; + true -> neg_inf + end + end. width({Min, Max}) -> infinity_max([width(Min), width(Max)]); width(pos_inf) -> pos_inf; @@ -1828,16 +1980,38 @@ negwidth(X, N) -> false -> negwidth(X, N+1) end. -arith('bnot', X1) -> - case t_is_integer(X1) of +arith_bnot(X1, Opaques) -> + case t_is_integer(X1, Opaques) of false -> error; true -> - Min1 = number_min(X1), - Max1 = number_max(X1), + Min1 = number_min(X1, Opaques), + Max1 = number_max(X1, Opaques), {ok, t_from_range(infinity_add(infinity_inv(Max1), -1), infinity_add(infinity_inv(Min1), -1))} end. +arith_abs(X1, Opaques) -> + case t_is_integer(X1, Opaques) of + false -> + case t_is_float(X1, Opaques) of + true -> t_float(); + false -> t_number() + end; + true -> + Min1 = number_min(X1, Opaques), + Max1 = number_max(X1, Opaques), + {NewMin, NewMax} = + case infinity_geq(Min1, 0) of + true -> {Min1, Max1}; + false -> + case infinity_geq(Max1, 0) of + true -> {0, infinity_inv(Min1)}; + false -> {infinity_inv(Max1), infinity_inv(Min1)} + end + end, + t_from_range(NewMin, NewMax) + end. + arith_mult(Min1, Max1, Min2, Max2) -> Tmp_list = [infinity_mult(Min1, Min2), infinity_mult(Min1, Max2), infinity_mult(Max1, Min2), infinity_mult(Max1, Max2)], @@ -1907,13 +2081,13 @@ arith_bor_range_set({Min, Max}, [Int|IntList]) -> IntList), {infinity_bor(Min, SafeAnd), infinity_bor(Max, SafeAnd)}. -arith_band(X1, X2) -> - L1 = t_number_vals(X1), - L2 = t_number_vals(X2), - Min1 = number_min(X1), - Max1 = number_max(X1), - Min2 = number_min(X2), - Max2 = number_max(X2), +arith_band(X1, X2, Opaques) -> + L1 = t_number_vals(X1, Opaques), + L2 = t_number_vals(X2, Opaques), + Min1 = number_min(X1, Opaques), + Max1 = number_max(X1, Opaques), + Min2 = number_min(X2, Opaques), + Max2 = number_max(X2, Opaques), case {L1 =:= unknown, L2 =:= unknown} of {true, false} -> arith_band_range_set(arith_band_ranges(Min1, Max1, Min2, Max2), L2); @@ -1923,13 +2097,13 @@ arith_band(X1, X2) -> arith_band_ranges(Min1, Max1, Min2, Max2) end. -arith_bor(X1, X2) -> - L1 = t_number_vals(X1), - L2 = t_number_vals(X2), - Min1 = number_min(X1), - Max1 = number_max(X1), - Min2 = number_min(X2), - Max2 = number_max(X2), +arith_bor(X1, X2, Opaques) -> + L1 = t_number_vals(X1, Opaques), + L2 = t_number_vals(X2, Opaques), + Min1 = number_min(X1, Opaques), + Max1 = number_max(X1, Opaques), + Min2 = number_min(X2, Opaques), + Max2 = number_max(X2, Opaques), case {L1 =:= unknown, L2 =:= unknown} of {true, false} -> arith_bor_range_set(arith_bor_ranges(Min1, Max1, Min2, Max2), L2); @@ -1967,19 +2141,19 @@ arith_bor_ranges(Min1, Max1, Min2, Max2) -> end, {Min, Max}. -arith(Op, X1, X2) -> +arith(Op, X1, X2, Opaques) -> %% io:format("arith ~p ~p ~p~n", [Op, X1, X2]), - case t_is_integer(X1) andalso t_is_integer(X2) of + case t_is_integer(X1, Opaques) andalso t_is_integer(X2, Opaques) of false -> error; true -> - L1 = t_number_vals(X1), - L2 = t_number_vals(X2), + L1 = t_number_vals(X1, Opaques), + L2 = t_number_vals(X2, Opaques), case (L1 =:= unknown) orelse (L2 =:= unknown) of true -> - Min1 = number_min(X1), - Max1 = number_max(X1), - Min2 = number_min(X2), - Max2 = number_max(X2), + Min1 = number_min(X1, Opaques), + Max1 = number_max(X1, Opaques), + Min2 = number_min(X2, Opaques), + Max2 = number_max(X2, Opaques), {NewMin, NewMax} = case Op of '+' -> {infinity_add(Min1, Min2), infinity_add(Max1, Max2)}; @@ -1992,8 +2166,8 @@ arith(Op, X1, X2) -> 'bsr' -> NewMin2 = infinity_inv(Max2), NewMax2 = infinity_inv(Min2), arith_bsl(Min1, Max1, NewMin2, NewMax2); - 'band' -> arith_band(X1, X2); - 'bor' -> arith_bor(X1, X2); + 'band' -> arith_band(X1, X2, Opaques); + 'bor' -> arith_bor(X1, X2, Opaques); 'bxor' -> arith_bor_ranges(Min1, Max1, Min2, Max2) %% overaprox. end, %% io:format("done arith ~p = ~p~n", [Op, {NewMin, NewMax}]), @@ -2025,58 +2199,62 @@ arith(Op, X1, X2) -> %% Comparison of terms %%============================================================================= -compare(Op, Lhs, Rhs) -> - case t_is_none(t_inf(Lhs, Rhs)) of +compare(Op, Lhs, Rhs, Opaques) -> + case t_is_none(t_inf(Lhs, Rhs, Opaques)) of false -> t_boolean(); true -> - case Op of - '<' -> always_smaller(Lhs, Rhs); - '>' -> always_smaller(Rhs, Lhs); - '=<' -> always_smaller(Lhs, Rhs); - '>=' -> always_smaller(Rhs, Lhs) + case opaque_args(erlang, Op, 2, [Lhs, Rhs], Opaques) =:= [] of + true -> + case Op of + '<' -> always_smaller(Lhs, Rhs, Opaques); + '>' -> always_smaller(Rhs, Lhs, Opaques); + '=<' -> always_smaller(Lhs, Rhs, Opaques); + '>=' -> always_smaller(Rhs, Lhs, Opaques) + end; + false -> t_none() end end. -always_smaller(Type1, Type2) -> - {Min1, Max1} = type_ranks(Type1), - {Min2, Max2} = type_ranks(Type2), +always_smaller(Type1, Type2, Opaques) -> + {Min1, Max1} = type_ranks(Type1, Opaques), + {Min2, Max2} = type_ranks(Type2, Opaques), if Max1 < Min2 -> t_atom('true'); Min1 > Max2 -> t_atom('false'); true -> t_boolean() end. -type_ranks(Type) -> - type_ranks(Type, 1, 0, 0, type_order()). +type_ranks(Type, Opaques) -> + type_ranks(Type, 1, 0, 0, type_order(), Opaques). -type_ranks(_Type, _I, Min, Max, []) -> {Min, Max}; -type_ranks(Type, I, Min, Max, [TypeClass|Rest]) -> +type_ranks(_Type, _I, Min, Max, [], _Opaques) -> {Min, Max}; +type_ranks(Type, I, Min, Max, [TypeClass|Rest], Opaques) -> {NewMin, NewMax} = - case t_is_none(t_inf(Type, TypeClass)) of + case t_is_none(t_inf(Type, TypeClass, Opaques)) of true -> {Min, Max}; false -> case Min of 0 -> {I, I}; _ -> {Min, I} end end, - type_ranks(Type, I+1, NewMin, NewMax, Rest). + type_ranks(Type, I+1, NewMin, NewMax, Rest, Opaques). type_order() -> [t_number(), t_atom(), t_reference(), t_fun(), t_port(), t_pid(), t_tuple(), - t_list(), t_binary()]. + t_map(), t_list(), t_bitstr()]. -key_comparisons_fail(X0, KeyPos, TupleList) -> - X = case t_is_number(t_inf(X0, t_number())) of +key_comparisons_fail(X0, KeyPos, TupleList, Opaques) -> + X = case t_is_number(t_inf(X0, t_number(), Opaques), Opaques) of false -> X0; true -> t_number() end, lists:all(fun(Tuple) -> Key = type(erlang, element, 2, [KeyPos, Tuple]), - t_is_none(t_inf(Key, X)) + t_is_none(t_inf(Key, X, Opaques)) end, TupleList). %%============================================================================= --spec arg_types(atom(), atom(), arity()) -> [erl_types:erl_type()] | 'unknown'. +-spec arg_types(atom(), atom(), arity()) -> arg_types() | 'unknown'. %%------- erlang -------------------------------------------------------------- arg_types(erlang, '!', 2) -> @@ -2162,9 +2340,7 @@ arg_types(erlang, bit_size, 1) -> [t_bitstr()]; %% Guard bif, needs to be here. arg_types(erlang, byte_size, 1) -> - [t_binary()]; -arg_types(erlang, disconnect_node, 1) -> - [t_node()]; + [t_bitstr()]; arg_types(erlang, halt, 0) -> []; arg_types(erlang, halt, 1) -> @@ -2184,17 +2360,11 @@ arg_types(erlang, element, 2) -> %% Guard bif, needs to be here. arg_types(erlang, float, 1) -> [t_number()]; -arg_types(erlang, fun_info, 1) -> - [t_fun()]; -arg_types(erlang, get_cookie, 0) -> - []; %% Guard bif, needs to be here. arg_types(erlang, hd, 1) -> [t_cons()]; arg_types(erlang, info, 1) -> arg_types(erlang, system_info, 1); % alias -arg_types(erlang, integer_to_list, 2) -> - [t_integer(), t_from_range(2, 36)]; arg_types(erlang, is_atom, 1) -> [t_any()]; arg_types(erlang, is_binary, 1) -> @@ -2213,6 +2383,8 @@ arg_types(erlang, is_integer, 1) -> [t_any()]; arg_types(erlang, is_list, 1) -> [t_any()]; +arg_types(erlang, is_map, 1) -> + [t_any()]; arg_types(erlang, is_number, 1) -> [t_any()]; arg_types(erlang, is_pid, 1) -> @@ -2230,12 +2402,15 @@ arg_types(erlang, is_tuple, 1) -> %% Guard bif, needs to be here. arg_types(erlang, length, 1) -> [t_list()]; +%% Guard bif, needs to be here. +arg_types(erlang, map_size, 1) -> + [t_map()]; +arg_types(erlang, make_fun, 3) -> + [t_atom(), t_atom(), t_arity()]; arg_types(erlang, make_tuple, 2) -> [t_non_neg_fixnum(), t_any()]; % the value 0 is OK as first argument arg_types(erlang, make_tuple, 3) -> [t_non_neg_fixnum(), t_any(), t_list(t_tuple([t_pos_integer(), t_any()]))]; -arg_types(erlang, memory, 0) -> - []; arg_types(erlang, nif_error, 1) -> [t_any()]; arg_types(erlang, nif_error, 2) -> @@ -2252,29 +2427,13 @@ arg_types(erlang, round, 1) -> %% Guard bif, needs to be here. arg_types(erlang, self, 0) -> []; -arg_types(erlang, set_cookie, 2) -> - [t_node(), t_atom()]; arg_types(erlang, setelement, 3) -> [t_pos_integer(), t_tuple(), t_any()]; %% Guard bif, needs to be here. arg_types(erlang, size, 1) -> [t_sup(t_tuple(), t_binary())]; -arg_types(erlang, spawn, 1) -> %% TODO: Tuple? - [t_fun()]; -arg_types(erlang, spawn, 2) -> %% TODO: Tuple? - [t_node(), t_fun()]; -arg_types(erlang, spawn, 4) -> %% TODO: Tuple? - [t_node(), t_atom(), t_atom(), t_list()]; -arg_types(erlang, spawn_link, 1) -> - arg_types(erlang, spawn, 1); % same -arg_types(erlang, spawn_link, 2) -> - arg_types(erlang, spawn, 2); % same -arg_types(erlang, spawn_link, 4) -> - arg_types(erlang, spawn, 4); % same arg_types(erlang, subtract, 2) -> arg_types(erlang, '--', 2); -arg_types(erlang, suspend_process, 1) -> - [t_pid()]; arg_types(erlang, system_info, 1) -> [t_sup([t_atom(), % documented t_tuple([t_atom(), t_any()]), % documented @@ -2293,11 +2452,6 @@ arg_types(erlang, tuple_size, 1) -> [t_tuple()]; arg_types(erlang, tuple_to_list, 1) -> [t_tuple()]; -arg_types(erlang, yield, 0) -> - []; -%%------- ets ----------------------------------------------------------------- -arg_types(ets, rename, 2) -> - [t_atom(), t_atom()]; %%------- hipe_bifs ----------------------------------------------------------- arg_types(hipe_bifs, add_ref, 2) -> [t_mfa(), t_tuple([t_mfa(), @@ -2349,16 +2503,12 @@ arg_types(hipe_bifs, find_na_or_make_stub, 2) -> [t_mfa(), t_boolean()]; arg_types(hipe_bifs, fun_to_address, 1) -> [t_mfa()]; -%% arg_types(hipe_bifs, get_emu_address, 1) -> -%% [t_mfa()]; +arg_types(hipe_bifs, get_fe, 2) -> + [t_atom(), t_tuple([t_integer(), t_integer(), t_integer()])]; arg_types(hipe_bifs, get_rts_param, 1) -> [t_fixnum()]; arg_types(hipe_bifs, invalidate_funinfo_native_addresses, 1) -> [t_list(t_mfa())]; -arg_types(hipe_bifs, make_fe, 3) -> - [t_integer(), t_atom(), t_tuple([t_integer(), t_integer(), t_integer()])]; -%% arg_types(hipe_bifs, make_native_stub, 2) -> -%% [t_integer(), t_arity()]; arg_types(hipe_bifs, mark_referred_from, 1) -> [t_mfa()]; arg_types(hipe_bifs, merge_term, 1) -> @@ -2385,8 +2535,10 @@ arg_types(hipe_bifs, set_funinfo_native_address, 3) -> arg_types(hipe_bifs, set_native_address, 3); arg_types(hipe_bifs, set_native_address, 3) -> [t_mfa(), t_integer(), t_boolean()]; -arg_types(hipe_bifs, system_crc, 1) -> - [t_crc32()]; +arg_types(hipe_bifs, set_native_address_in_fe, 2) -> + [t_integer(), t_integer()]; +arg_types(hipe_bifs, system_crc, 0) -> + []; arg_types(hipe_bifs, term_to_word, 1) -> [t_any()]; arg_types(hipe_bifs, update_code_size, 3) -> @@ -2496,59 +2648,102 @@ arg_types(lists, zipwith, 3) -> [t_fun([t_any(), t_any()], t_any()), t_list(), t_list()]; arg_types(lists, zipwith3, 4) -> [t_fun([t_any(), t_any(), t_any()], t_any()), t_list(), t_list(), t_list()]; - -%%------- string -------------------------------------------------------------- -arg_types(string, chars, 2) -> - [t_char(), t_non_neg_integer()]; -arg_types(string, chars, 3) -> - [t_char(), t_non_neg_integer(), t_any()]; -%%----------------------------------------------------------------------------- +%%------- maps ---------------------------------------------------------------- +arg_types(maps, from_list, 1) -> + [t_list(t_tuple(2))]; +arg_types(maps, get, 2) -> + [t_any(), t_map()]; +arg_types(maps, is_key, 2) -> + [t_any(), t_map()]; +arg_types(maps, merge, 2) -> + [t_map(), t_map()]; +arg_types(maps, put, 3) -> + [t_any(), t_any(), t_map()]; +arg_types(maps, size, 1) -> + [t_map()]; +arg_types(maps, to_list, 1) -> + [t_map()]; +arg_types(maps, update, 3) -> + [t_any(), t_any(), t_map()]; arg_types(M, F, A) when is_atom(M), is_atom(F), is_integer(A), 0 =< A, A =< 255 -> unknown. % safe approximation for all functions. --spec is_known(atom(), atom(), arity()) -> boolean(). +-spec is_known(module(), atom(), arity()) -> boolean(). is_known(M, F, A) -> arg_types(M, F, A) =/= unknown. +-spec opaque_args(module(), atom(), arity(), + arg_types(), opaques()) -> [pos_integer()]. + +%% Use this function to find out which argument caused empty type. + +opaque_args(_M, _F, _A, _Xs, 'universe') -> []; +opaque_args(M, F, A, Xs, Opaques) -> + case kind_of_check(M, F, A) of + record -> + [X,Y|_] = Xs, + [1 || + case t_is_tuple(X, Opaques) of + true -> + case t_tuple_subtypes(X, Opaques) of + unknown -> false; + List when length(List) >= 1 -> + (t_is_atom(Y, Opaques) andalso + opaque_recargs(List, Y, Opaques)) + end; + false -> t_has_opaque_subtype(X, Opaques) + end]; + subtype -> + [N || + {N, X} <- lists:zip(lists:seq(1, length(Xs)), Xs), + t_has_opaque_subtype(X, Opaques)]; + find_unknown -> + [L, R] = Xs, + erl_types:t_find_unknown_opaque(L, R, Opaques); + no_check -> [] + end. --spec structure_inspecting_args(atom(), atom(), arity()) -> [1..255]. - -structure_inspecting_args(erlang, element, 2) -> [2]; -structure_inspecting_args(erlang, is_atom, 1) -> [1]; -structure_inspecting_args(erlang, is_boolean, 1) -> [1]; -structure_inspecting_args(erlang, is_binary, 1) -> [1]; -structure_inspecting_args(erlang, is_bitstring, 1) -> [1]; -structure_inspecting_args(erlang, is_float, 1) -> [1]; -structure_inspecting_args(erlang, is_function, 1) -> [1]; -structure_inspecting_args(erlang, is_integer, 1) -> [1]; -structure_inspecting_args(erlang, is_list, 1) -> [1]; -structure_inspecting_args(erlang, is_number, 1) -> [1]; -structure_inspecting_args(erlang, is_pid, 1) -> [1]; -structure_inspecting_args(erlang, is_port, 1) -> [1]; -structure_inspecting_args(erlang, is_reference, 1) -> [1]; -structure_inspecting_args(erlang, is_tuple, 1) -> [1]; -structure_inspecting_args(erlang, length, 1) -> [1]; -%%structure_inspecting_args(erlang, setelement, 3) -> [2]. -structure_inspecting_args(_, _, _) -> []. % XXX: assume no arg needs inspection - - -check_fun_application(Fun, Args) -> - case t_is_fun(Fun) of +kind_of_check(erlang, is_record, 3) -> + record; +kind_of_check(erlang, is_record, 2) -> + record; +kind_of_check(erlang, F, A) -> + case erl_internal:guard_bif(F, A) orelse erl_internal:bool_op(F, A) of + true -> subtype; + false -> + case erl_internal:comp_op(F, A) of + true -> find_unknown; + false -> no_check + end + end; +kind_of_check(_M, _F, _A) -> no_check. + +opaque_recargs(Tuples, Y, Opaques) -> + Fun = fun(Tuple) -> + case t_tuple_args(Tuple, Opaques) of + [Tag|_] -> t_is_none(check_record_tag(Tag, Y, Opaques)); + _ -> false + end + end, + lists:all(Fun, Tuples). + +check_fun_application(Fun, Args, Opaques) -> + case t_is_fun(Fun, Opaques) of true -> - case t_fun_args(Fun) of + case t_fun_args(Fun, Opaques) of unknown -> - case t_is_none_or_unit(t_fun_range(Fun)) of + case t_is_none_or_unit(t_fun_range(Fun, Opaques)) of true -> error; false -> ok end; FunDom when length(FunDom) =:= length(Args) -> - case any_is_none_or_unit(inf_lists(FunDom, Args)) of + case any_is_none_or_unit(inf_lists(FunDom, Args, Opaques)) of true -> error; false -> - case t_is_none_or_unit(t_fun_range(Fun)) of + case t_is_none_or_unit(t_fun_range(Fun, Opaques)) of true -> error; false -> ok end diff --git a/lib/hipe/cerl/erl_types.erl b/lib/hipe/cerl/erl_types.erl index d1243b2325..7826dada9d 100644 --- a/lib/hipe/cerl/erl_types.erl +++ b/lib/hipe/cerl/erl_types.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2013. All Rights Reserved. +%% Copyright Ericsson AB 2003-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -40,17 +41,16 @@ any_none_or_unit/1, lookup_record/3, max/2, - module_builtin_opaques/1, min/2, - number_max/1, - number_min/1, + number_max/1, number_max/2, + number_min/1, number_min/2, t_abstract_records/2, t_any/0, t_arity/0, t_atom/0, t_atom/1, t_atoms/1, - t_atom_vals/1, + t_atom_vals/1, t_atom_vals/2, t_binary/0, t_bitstr/0, t_bitstr/2, @@ -66,39 +66,41 @@ t_collect_vars/1, t_cons/0, t_cons/2, - t_cons_hd/1, - t_cons_tl/1, - t_constant/0, - t_contains_opaque/1, + t_cons_hd/1, t_cons_hd/2, + t_cons_tl/1, t_cons_tl/2, + t_contains_opaque/1, t_contains_opaque/2, + t_decorate_with_opaque/3, t_elements/1, - t_find_opaque_mismatch/2, + t_find_opaque_mismatch/3, + t_find_unknown_opaque/3, t_fixnum/0, t_map/2, t_non_neg_fixnum/0, t_pos_fixnum/0, t_float/0, + t_var_names/1, t_form_to_string/1, - t_from_form/1, - t_from_form/2, - t_from_form/3, + t_from_form/6, + t_from_form_without_remote/3, + t_check_record_fields/6, t_from_range/2, t_from_range_unsafe/2, t_from_term/1, t_fun/0, t_fun/1, t_fun/2, - t_fun_args/1, - t_fun_arity/1, - t_fun_range/1, - t_has_opaque_subtype/1, + t_fun_args/1, t_fun_args/2, + t_fun_arity/1, t_fun_arity/2, + t_fun_range/1, t_fun_range/2, + t_has_opaque_subtype/2, t_has_var/1, t_identifier/0, %% t_improper_list/2, - t_inf/2, - t_inf/3, - t_inf_lists/2, - t_inf_lists/3, - t_inf_lists_masked/3, + t_inf/1, + t_inf/2, + t_inf/3, + t_inf_lists/2, + t_inf_lists/3, t_integer/0, t_integer/1, t_non_neg_integer/0, @@ -107,45 +109,57 @@ t_iodata/0, t_iolist/0, t_is_any/1, - t_is_atom/1, - t_is_atom/2, - t_is_binary/1, - t_is_bitstr/1, + t_is_atom/1, t_is_atom/2, + t_is_any_atom/2, t_is_any_atom/3, + t_is_binary/1, t_is_binary/2, + t_is_bitstr/1, t_is_bitstr/2, t_is_bitwidth/1, - t_is_boolean/1, + t_is_boolean/1, t_is_boolean/2, %% t_is_byte/1, %% t_is_char/1, - t_is_cons/1, - t_is_constant/1, + t_is_cons/1, t_is_cons/2, t_is_equal/2, t_is_fixnum/1, - t_is_float/1, - t_is_fun/1, + t_is_float/1, t_is_float/2, + t_is_fun/1, t_is_fun/2, t_is_instance/2, - t_is_integer/1, + t_is_integer/1, t_is_integer/2, t_is_list/1, + t_is_map/1, + t_is_map/2, t_is_matchstate/1, - t_is_nil/1, + t_is_nil/1, t_is_nil/2, t_is_non_neg_integer/1, t_is_none/1, t_is_none_or_unit/1, - t_is_number/1, - t_is_opaque/1, - t_is_pid/1, - t_is_port/1, - t_is_maybe_improper_list/1, - t_is_reference/1, - t_is_remote/1, + t_is_number/1, t_is_number/2, + t_is_opaque/1, t_is_opaque/2, + t_is_pid/1, t_is_pid/2, + t_is_port/1, t_is_port/2, + t_is_maybe_improper_list/1, t_is_maybe_improper_list/2, + t_is_reference/1, t_is_reference/2, + t_is_singleton/1, + t_is_singleton/2, t_is_string/1, t_is_subtype/2, - t_is_tuple/1, + t_is_tuple/1, t_is_tuple/2, t_is_unit/1, t_is_var/1, t_limit/2, t_list/0, t_list/1, - t_list_elements/1, - t_list_termination/1, + t_list_elements/1, t_list_elements/2, + t_list_termination/1, t_list_termination/2, + t_map/0, + t_map/1, + t_map/3, + t_map_entries/2, t_map_entries/1, + t_map_def_key/2, t_map_def_key/1, + t_map_def_val/2, t_map_def_val/1, + t_map_get/2, t_map_get/3, + t_map_is_key/2, t_map_is_key/3, + t_map_update/2, t_map_update/3, + t_map_put/2, t_map_put/3, t_matchstate/0, t_matchstate/2, t_matchstate_present/1, @@ -163,54 +177,50 @@ t_nonempty_string/0, t_number/0, t_number/1, - t_number_vals/1, + t_number_vals/1, t_number_vals/2, t_opaque_from_records/1, - t_opaque_match_atom/2, - t_opaque_match_record/2, - t_opaque_matching_structure/2, t_opaque_structure/1, - %% t_parameterized_module/0, t_pid/0, t_port/0, t_maybe_improper_list/0, %% t_maybe_improper_list/2, t_product/1, t_reference/0, - t_remote/3, + t_singleton_to_term/2, t_string/0, t_struct_from_opaque/2, - t_solve_remote/3, t_subst/2, t_subtract/2, t_subtract_list/2, t_sup/1, t_sup/2, - t_tid/0, t_timeout/0, t_to_string/1, t_to_string/2, t_to_tlist/1, t_tuple/0, t_tuple/1, - t_tuple_args/1, - t_tuple_size/1, + t_tuple_args/1, t_tuple_args/2, + t_tuple_size/1, t_tuple_size/2, t_tuple_sizes/1, t_tuple_subtypes/1, + t_tuple_subtypes/2, t_unify/2, - t_unify/3, t_unit/0, - t_unopaque/1, - t_unopaque/2, - t_unopaque_on_mismatch/3, + t_unopaque/1, t_unopaque/2, t_var/1, t_var_name/1, %% t_assign_variables_to_subtype/2, type_is_defined/4, record_field_diffs_to_string/2, subst_all_vars_to_any/1, - lift_list_to_pos_empty/1, + lift_list_to_pos_empty/1, lift_list_to_pos_empty/2, + is_opaque_type/2, is_erl_type/1, - atom_to_string/1 + atom_to_string/1, + var_table__new/0, + cache__new/0, + map_pairwise_merge/3 ]). %%-define(DO_ERL_TYPES_TEST, true). @@ -226,7 +236,15 @@ -export([t_is_identifier/1]). -endif. --export_type([erl_type/0]). +-export_type([erl_type/0, opaques/0, type_table/0, var_table/0, cache/0]). + +%%-define(DEBUG, true). + +-ifdef(DEBUG). +-define(debug(__A), __A). +-else. +-define(debug(__A), ok). +-endif. %%============================================================================= %% @@ -239,6 +257,8 @@ %% -define(REC_TYPE_LIMIT, 2). +-define(EXPAND_DEPTH, 16). +-define(EXPAND_LIMIT, 10000). -define(TUPLE_TAG_LIMIT, 5). -define(TUPLE_ARITY_LIMIT, 8). @@ -251,6 +271,8 @@ -define(TAG_IMMED1_SIZE, 4). -define(BITS, (erlang:system_info(wordsize) * 8) - ?TAG_IMMED1_SIZE). +-define(MAX_TUPLE_SIZE, (1 bsl 10)). + %%----------------------------------------------------------------------------- %% Type tags and qualifiers %% @@ -260,20 +282,20 @@ -define(function_tag, function). -define(identifier_tag, identifier). -define(list_tag, list). +-define(map_tag, map). -define(matchstate_tag, matchstate). -define(nil_tag, nil). -define(number_tag, number). -define(opaque_tag, opaque). -define(product_tag, product). --define(remote_tag, remote). -define(tuple_set_tag, tuple_set). -define(tuple_tag, tuple). -define(union_tag, union). -define(var_tag, var). -type tag() :: ?atom_tag | ?binary_tag | ?function_tag | ?identifier_tag - | ?list_tag | ?matchstate_tag | ?nil_tag | ?number_tag - | ?opaque_tag | ?product_tag | ?remote_tag + | ?list_tag | ?map_tag | ?matchstate_tag | ?nil_tag | ?number_tag + | ?opaque_tag | ?product_tag | ?tuple_tag | ?tuple_set_tag | ?union_tag | ?var_tag. -define(float_qual, float). @@ -305,14 +327,16 @@ %% Auxiliary types and convenient macros %% --type parse_form() :: {atom(), _, _} | {atom(), _, _, _} | {'op', _, _, _, _}. %% XXX: Temporarily +-type parse_form() :: erl_parse:abstract_type(). -type rng_elem() :: 'pos_inf' | 'neg_inf' | integer(). -record(int_set, {set :: [integer()]}). -record(int_rng, {from :: rng_elem(), to :: rng_elem()}). +%% Note: the definition of #opaque{} was changed to 'mod' and 'name'; +%% it used to be an ordsets of {Mod, Name} pairs. The Dialyzer version +%% was updated to 2.7 due to this change. -record(opaque, {mod :: module(), name :: atom(), args = [] :: [erl_type()], struct :: erl_type()}). --record(remote, {mod:: module(), name :: atom(), args = [] :: [erl_type()]}). -define(atom(Set), #c{tag=?atom_tag, elements=Set}). -define(bitstr(Unit, Base), #c{tag=?binary_tag, elements=[Unit,Base]}). @@ -329,9 +353,10 @@ -define(nonempty_list(Types, Term),?list(Types, Term, ?nonempty_qual)). -define(number(Set, Qualifier), #c{tag=?number_tag, elements=Set, qualifier=Qualifier}). +-define(map(Pairs,DefKey,DefVal), + #c{tag=?map_tag, elements={Pairs,DefKey,DefVal}}). -define(opaque(Optypes), #c{tag=?opaque_tag, elements=Optypes}). -define(product(Types), #c{tag=?product_tag, elements=Types}). --define(remote(RemTypes), #c{tag=?remote_tag, elements=RemTypes}). -define(tuple(Types, Arity, Qual), #c{tag=?tuple_tag, elements=Types, qualifier={Arity, Qual}}). -define(tuple_set(Tuples), #c{tag=?tuple_set_tag, elements=Tuples}). @@ -346,6 +371,19 @@ -define(integer_non_neg, ?int_range(0, pos_inf)). -define(integer_neg, ?int_range(neg_inf, -1)). +-type opaques() :: [erl_type()] | 'universe'. + +-type record_key() :: {'record', atom()}. +-type type_key() :: {'type' | 'opaque', mfa()}. +-type record_value() :: [{atom(), erl_parse:abstract_expr(), erl_type()}]. +-type type_value() :: {{module(), {file:name(), erl_anno:line()}, + erl_parse:abstract_type(), ArgNames :: [atom()]}, + erl_type()}. +-type type_table() :: dict:dict(record_key() | type_key(), + record_value() | type_value()). + +-opaque var_table() :: #{atom() => erl_type()}. + %%----------------------------------------------------------------------------- %% Unions %% @@ -361,7 +399,7 @@ -define(tuple_union(T), ?union([?none,?none,?none,?none,?none,?none,T,?none,?none,?none])). -define(matchstate_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,T,?none,?none])). -define(opaque_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,?none,T,?none])). --define(remote_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,?none,?none,T])). +-define(map_union(T), ?union([?none,?none,?none,?none,?none,?none,?none,?none,?none,T])). -define(integer_union(T), ?number_union(T)). -define(float_union(T), ?number_union(T)). -define(nil_union(T), ?list_union(T)). @@ -384,8 +422,11 @@ t_any() -> -spec t_is_any(erl_type()) -> boolean(). -t_is_any(?any) -> true; -t_is_any(_) -> false. +t_is_any(Type) -> + do_opaque(Type, 'universe', fun is_any/1). + +is_any(?any) -> true; +is_any(_) -> false. -spec t_none() -> erl_type(). @@ -407,16 +448,25 @@ t_opaque(Mod, Name, Args, Struct) -> O = #opaque{mod = Mod, name = Name, args = Args, struct = Struct}, ?opaque(set_singleton(O)). +-spec t_is_opaque(erl_type(), [erl_type()]) -> boolean(). + +t_is_opaque(?opaque(_) = Type, Opaques) -> + not is_opaque_type(Type, Opaques); +t_is_opaque(_Type, _Opaques) -> false. + -spec t_is_opaque(erl_type()) -> boolean(). t_is_opaque(?opaque(_)) -> true; t_is_opaque(_) -> false. --spec t_has_opaque_subtype(erl_type()) -> boolean(). +-spec t_has_opaque_subtype(erl_type(), opaques()) -> boolean(). + +t_has_opaque_subtype(Type, Opaques) -> + do_opaque(Type, Opaques, fun has_opaque_subtype/1). -t_has_opaque_subtype(?union(Ts)) -> +has_opaque_subtype(?union(Ts)) -> lists:any(fun t_is_opaque/1, Ts); -t_has_opaque_subtype(T) -> +has_opaque_subtype(T) -> t_is_opaque(T). -spec t_opaque_structure(erl_type()) -> erl_type(). @@ -424,74 +474,54 @@ t_has_opaque_subtype(T) -> t_opaque_structure(?opaque(Elements)) -> t_sup([Struct || #opaque{struct = Struct} <- ordsets:to_list(Elements)]). --spec t_opaque_module(erl_type()) -> module(). - -t_opaque_module(?opaque(Elements)) -> - case ordsets:size(Elements) of - 1 -> - [#opaque{mod = Module}] = ordsets:to_list(Elements), - Module; - _ -> throw({error, "Unexpected multiple opaque types"}) - end. - -%% This only makes sense if we know that Type matches Opaque --spec t_opaque_matching_structure(erl_type(), erl_type()) -> erl_type(). - -t_opaque_matching_structure(Type, Opaque) -> - OpaqueStruct = t_opaque_structure(Opaque), - case OpaqueStruct of - ?union(L1) -> - case Type of - ?union(_L2) -> OpaqueStruct; - _OtherType -> t_opaque_matching_structure_list(Type, L1) - end; - ?tuple_set(_Set1) = TupleSet -> - case Type of - ?tuple_set(_Set2) -> OpaqueStruct; - _ -> t_opaque_matching_structure_list(Type, t_tuple_subtypes(TupleSet)) - end; - _Other -> OpaqueStruct - end. - -t_opaque_matching_structure_list(Type, List) -> - NewList = [t_inf(Element, Type) || Element <- List], - Results = [NotNone || NotNone <- NewList, NotNone =/= ?none], - case Results of - [] -> ?none; - [First|_] -> First - end. - -spec t_contains_opaque(erl_type()) -> boolean(). -t_contains_opaque(?any) -> false; -t_contains_opaque(?none) -> false; -t_contains_opaque(?unit) -> false; -t_contains_opaque(?atom(_Set)) -> false; -t_contains_opaque(?bitstr(_Unit, _Base)) -> false; -t_contains_opaque(?float) -> false; -t_contains_opaque(?function(Domain, Range)) -> - t_contains_opaque(Domain) orelse t_contains_opaque(Range); -t_contains_opaque(?identifier(_Types)) -> false; -t_contains_opaque(?integer(_Types)) -> false; -t_contains_opaque(?int_range(_From, _To)) -> false; -t_contains_opaque(?int_set(_Set)) -> false; -t_contains_opaque(?list(Type, _, _)) -> t_contains_opaque(Type); -t_contains_opaque(?matchstate(_P, _Slots)) -> false; -t_contains_opaque(?nil) -> false; -t_contains_opaque(?number(_Set, _Tag)) -> false; -t_contains_opaque(?opaque(_)) -> true; -t_contains_opaque(?product(Types)) -> list_contains_opaque(Types); -t_contains_opaque(?tuple(?any, _, _)) -> false; -t_contains_opaque(?tuple(Types, _, _)) -> list_contains_opaque(Types); -t_contains_opaque(?tuple_set(_Set) = T) -> - list_contains_opaque(t_tuple_subtypes(T)); -t_contains_opaque(?union(List)) -> list_contains_opaque(List); -t_contains_opaque(?var(_Id)) -> false. - --spec list_contains_opaque([erl_type()]) -> boolean(). - -list_contains_opaque(List) -> - lists:any(fun t_contains_opaque/1, List). +t_contains_opaque(Type) -> + t_contains_opaque(Type, []). + +%% Returns 'true' iff there is an opaque type that is *not* one of +%% the types of the second argument. + +-spec t_contains_opaque(erl_type(), [erl_type()]) -> boolean(). + +t_contains_opaque(?any, _Opaques) -> false; +t_contains_opaque(?none, _Opaques) -> false; +t_contains_opaque(?unit, _Opaques) -> false; +t_contains_opaque(?atom(_Set), _Opaques) -> false; +t_contains_opaque(?bitstr(_Unit, _Base), _Opaques) -> false; +t_contains_opaque(?float, _Opaques) -> false; +t_contains_opaque(?function(Domain, Range), Opaques) -> + t_contains_opaque(Domain, Opaques) + orelse t_contains_opaque(Range, Opaques); +t_contains_opaque(?identifier(_Types), _Opaques) -> false; +t_contains_opaque(?integer(_Types), _Opaques) -> false; +t_contains_opaque(?int_range(_From, _To), _Opaques) -> false; +t_contains_opaque(?int_set(_Set), _Opaques) -> false; +t_contains_opaque(?list(Type, Tail, _), Opaques) -> + t_contains_opaque(Type, Opaques) orelse t_contains_opaque(Tail, Opaques); +t_contains_opaque(?map(_, _, _) = Map, Opaques) -> + list_contains_opaque(map_all_types(Map), Opaques); +t_contains_opaque(?matchstate(_P, _Slots), _Opaques) -> false; +t_contains_opaque(?nil, _Opaques) -> false; +t_contains_opaque(?number(_Set, _Tag), _Opaques) -> false; +t_contains_opaque(?opaque(_)=T, Opaques) -> + not is_opaque_type(T, Opaques) + orelse t_contains_opaque(t_opaque_structure(T)); +t_contains_opaque(?product(Types), Opaques) -> + list_contains_opaque(Types, Opaques); +t_contains_opaque(?tuple(?any, _, _), _Opaques) -> false; +t_contains_opaque(?tuple(Types, _, _), Opaques) -> + list_contains_opaque(Types, Opaques); +t_contains_opaque(?tuple_set(_Set) = T, Opaques) -> + list_contains_opaque(t_tuple_subtypes(T), Opaques); +t_contains_opaque(?union(List), Opaques) -> + list_contains_opaque(List, Opaques); +t_contains_opaque(?var(_Id), _Opaques) -> false. + +-spec list_contains_opaque([erl_type()], [erl_type()]) -> boolean(). + +list_contains_opaque(List, Opaques) -> + lists:any(fun(E) -> t_contains_opaque(E, Opaques) end, List). %% t_find_opaque_mismatch/2 of two types should only be used if their %% t_inf is t_none() due to some opaque type violation. @@ -499,36 +529,51 @@ list_contains_opaque(List) -> %% The first argument of the function is the pattern and its second %% argument the type we are matching against the pattern. --spec t_find_opaque_mismatch(erl_type(), erl_type()) -> 'error' | {'ok', erl_type(), erl_type()}. - -t_find_opaque_mismatch(T1, T2) -> - t_find_opaque_mismatch(T1, T2, T2). - -t_find_opaque_mismatch(?any, _Type, _TopType) -> error; -t_find_opaque_mismatch(?none, _Type, _TopType) -> error; -t_find_opaque_mismatch(?list(T1, _, _), ?list(T2, _, _), TopType) -> - t_find_opaque_mismatch(T1, T2, TopType); -t_find_opaque_mismatch(_T1, ?opaque(_) = T2, TopType) -> {ok, TopType, T2}; -t_find_opaque_mismatch(?product(T1), ?product(T2), TopType) -> - t_find_opaque_mismatch_ordlists(T1, T2, TopType); -t_find_opaque_mismatch(?tuple(T1, Arity, _), ?tuple(T2, Arity, _), TopType) -> - t_find_opaque_mismatch_ordlists(T1, T2, TopType); -t_find_opaque_mismatch(?tuple(_, _, _) = T1, ?tuple_set(_) = T2, TopType) -> +-spec t_find_opaque_mismatch(erl_type(), erl_type(), [erl_type()]) -> + 'error' | {'ok', erl_type(), erl_type()}. + +t_find_opaque_mismatch(T1, T2, Opaques) -> + t_find_opaque_mismatch(T1, T2, T2, Opaques). + +t_find_opaque_mismatch(?any, _Type, _TopType, _Opaques) -> error; +t_find_opaque_mismatch(?none, _Type, _TopType, _Opaques) -> error; +t_find_opaque_mismatch(?list(T1, Tl1, _), ?list(T2, Tl2, _), TopType, Opaques) -> + t_find_opaque_mismatch_ordlists([T1, Tl1], [T2, Tl2], TopType, Opaques); +t_find_opaque_mismatch(T1, ?opaque(_) = T2, TopType, Opaques) -> + case is_opaque_type(T2, Opaques) of + false -> {ok, TopType, T2}; + true -> + t_find_opaque_mismatch(T1, t_opaque_structure(T2), TopType, Opaques) + end; +t_find_opaque_mismatch(?opaque(_) = T1, T2, TopType, Opaques) -> + %% The generated message is somewhat misleading: + case is_opaque_type(T1, Opaques) of + false -> {ok, TopType, T1}; + true -> + t_find_opaque_mismatch(t_opaque_structure(T1), T2, TopType, Opaques) + end; +t_find_opaque_mismatch(?product(T1), ?product(T2), TopType, Opaques) -> + t_find_opaque_mismatch_ordlists(T1, T2, TopType, Opaques); +t_find_opaque_mismatch(?tuple(T1, Arity, _), ?tuple(T2, Arity, _), + TopType, Opaques) -> + t_find_opaque_mismatch_ordlists(T1, T2, TopType, Opaques); +t_find_opaque_mismatch(?tuple(_, _, _) = T1, ?tuple_set(_) = T2, + TopType, Opaques) -> Tuples1 = t_tuple_subtypes(T1), Tuples2 = t_tuple_subtypes(T2), - t_find_opaque_mismatch_lists(Tuples1, Tuples2, TopType); -t_find_opaque_mismatch(T1, ?union(U2), TopType) -> - t_find_opaque_mismatch_lists([T1], U2, TopType); -t_find_opaque_mismatch(_T1, _T2, _TopType) -> error. + t_find_opaque_mismatch_lists(Tuples1, Tuples2, TopType, Opaques); +t_find_opaque_mismatch(T1, ?union(U2), TopType, Opaques) -> + t_find_opaque_mismatch_lists([T1], U2, TopType, Opaques); +t_find_opaque_mismatch(_T1, _T2, _TopType, _Opaques) -> error. -t_find_opaque_mismatch_ordlists(L1, L2, TopType) -> +t_find_opaque_mismatch_ordlists(L1, L2, TopType, Opaques) -> List = lists:zipwith(fun(T1, T2) -> - t_find_opaque_mismatch(T1, T2, TopType) + t_find_opaque_mismatch(T1, T2, TopType, Opaques) end, L1, L2), t_find_opaque_mismatch_list(List). -t_find_opaque_mismatch_lists(L1, L2, _TopType) -> - List = [t_find_opaque_mismatch(T1, T2, T2) || T1 <- L1, T2 <- L2], +t_find_opaque_mismatch_lists(L1, L2, _TopType, Opaques) -> + List = [t_find_opaque_mismatch(T1, T2, T2, Opaques) || T1 <- L1, T2 <- L2], t_find_opaque_mismatch_list(List). t_find_opaque_mismatch_list([]) -> error; @@ -538,7 +583,167 @@ t_find_opaque_mismatch_list([H|T]) -> error -> t_find_opaque_mismatch_list(T) end. --spec t_opaque_from_records(dict()) -> [erl_type()]. +-spec t_find_unknown_opaque(erl_type(), erl_type(), opaques()) -> + [pos_integer()]. + +%% The nice thing about using two types and t_inf() as compared to +%% calling t_contains_opaque/2 is that the traversal stops when +%% there is a mismatch which means that unknown opaque types "below" +%% the mismatch are not found. +t_find_unknown_opaque(_T1, _T2, 'universe') -> []; +t_find_unknown_opaque(T1, T2, Opaques) -> + try t_inf(T1, T2, {match, Opaques}) of + _ -> [] + catch throw:{pos, Ns} -> Ns + end. + +-spec t_decorate_with_opaque(erl_type(), erl_type(), [erl_type()]) -> erl_type(). + +%% The first argument can contain opaque types. The second argument +%% is assumed to be taken from the contract. + +t_decorate_with_opaque(T1, T2, Opaques) -> + case t_is_equal(T1, T2) orelse not t_contains_opaque(T2) of + true -> T1; + false -> + T = t_inf(T1, T2), + case t_contains_opaque(T) of + false -> T1; + true -> + R = decorate(T1, T, Opaques), + ?debug(case catch t_is_equal(t_unopaque(R), t_unopaque(T1)) of + true -> ok; + false -> + io:format("T1 = ~p,\n", [T1]), + io:format("T2 = ~p,\n", [T2]), + io:format("O = ~p,\n", [Opaques]), + io:format("erl_types:t_decorate_with_opaque(T1,T2,O).\n"), + throw({error, "Failed to handle opaque types"}) + end), + R + end + end. + +decorate(Type, ?none, _Opaques) -> Type; +decorate(?function(Domain, Range), ?function(D, R), Opaques) -> + ?function(decorate(Domain, D, Opaques), decorate(Range, R, Opaques)); +decorate(?list(Types, Tail, Size), ?list(Ts, Tl, _Sz), Opaques) -> + ?list(decorate(Types, Ts, Opaques), decorate(Tail, Tl, Opaques), Size); +decorate(?product(Types), ?product(Ts), Opaques) -> + ?product(list_decorate(Types, Ts, Opaques)); +decorate(?tuple(_, _, _)=T, ?tuple(?any, _, _), _Opaques) -> T; +decorate(?tuple(?any, _, _)=T, ?tuple(_, _, _), _Opaques) -> T; +decorate(?tuple(Types, Arity, Tag), ?tuple(Ts, Arity, _), Opaques) -> + ?tuple(list_decorate(Types, Ts, Opaques), Arity, Tag); +decorate(?tuple_set(List), ?tuple(_, Arity, _) = T, Opaques) -> + decorate_tuple_sets(List, [{Arity, [T]}], Opaques); +decorate(?tuple_set(List), ?tuple_set(L), Opaques) -> + decorate_tuple_sets(List, L, Opaques); +decorate(?union(List), T, Opaques) when T =/= ?any -> + ?union(L) = force_union(T), + union_decorate(List, L, Opaques); +decorate(?opaque(_)=T, _, _Opaques) -> T; +decorate(T, ?union(L), Opaques) when T =/= ?any -> + ?union(List) = force_union(T), + union_decorate(List, L, Opaques); +decorate(Type, ?opaque(_)=T, Opaques) -> + decorate_with_opaque(Type, T, Opaques); +decorate(Type, _T, _Opaques) -> Type. + +%% Note: it is important that #opaque.struct is a subtype of the +%% opaque type. +decorate_with_opaque(Type, ?opaque(Set2), Opaques) -> + case decoration(set_to_list(Set2), Type, Opaques, [], false) of + {[], false} -> Type; + {List, All} when List =/= [] -> + NewType = ?opaque(ordsets:from_list(List)), + case All of + true -> NewType; + false -> t_sup(NewType, Type) + end + end. + +decoration([#opaque{struct = S} = Opaque|OpaqueTypes], Type, Opaques, + NewOpaqueTypes0, All) -> + IsOpaque = is_opaque_type2(Opaque, Opaques), + I = t_inf(Type, S), + case not IsOpaque orelse t_is_none(I) of + true -> decoration(OpaqueTypes, Type, Opaques, NewOpaqueTypes0, All); + false -> + NewOpaque = Opaque#opaque{struct = decorate(I, S, Opaques)}, + NewAll = All orelse t_is_equal(I, Type), + NewOpaqueTypes = [NewOpaque|NewOpaqueTypes0], + decoration(OpaqueTypes, Type, Opaques, NewOpaqueTypes, NewAll) + end; +decoration([], _Type, _Opaques, NewOpaqueTypes, All) -> + {NewOpaqueTypes, All}. + +-spec list_decorate([erl_type()], [erl_type()], opaques()) -> [erl_type()]. + +list_decorate(List, L, Opaques) -> + [decorate(Elem, E, Opaques) || {Elem, E} <- lists:zip(List, L)]. + +union_decorate(U1, U2, Opaques) -> + Union = union_decorate(U1, U2, Opaques, 0, []), + [A,B,F,I,L,N,T,M,_,Map] = U1, + [_,_,_,_,_,_,_,_,Opaque,_] = U2, + List = [A,B,F,I,L,N,T,M,Map], + DecList = [Dec || + E <- List, + not t_is_none(E), + not t_is_none(Dec = decorate(E, Opaque, Opaques))], + t_sup([Union|DecList]). + +union_decorate([?none|Left1], [_|Left2], Opaques, N, Acc) -> + union_decorate(Left1, Left2, Opaques, N, [?none|Acc]); +union_decorate([T1|Left1], [?none|Left2], Opaques, N, Acc) -> + union_decorate(Left1, Left2, Opaques, N+1, [T1|Acc]); +union_decorate([T1|Left1], [T2|Left2], Opaques, N, Acc) -> + union_decorate(Left1, Left2, Opaques, N+1, [decorate(T1, T2, Opaques)|Acc]); +union_decorate([], [], _Opaques, N, Acc) -> + if N =:= 0 -> ?none; + N =:= 1 -> + [Type] = [T || T <- Acc, T =/= ?none], + Type; + N >= 2 -> ?union(lists:reverse(Acc)) + end. + +decorate_tuple_sets(List, L, Opaques) -> + decorate_tuple_sets(List, L, Opaques, []). + +decorate_tuple_sets([{Arity, Tuples}|List], [{Arity, Ts}|L], Opaques, Acc) -> + DecTs = decorate_tuples_in_sets(Tuples, Ts, Opaques), + decorate_tuple_sets(List, L, Opaques, [{Arity, DecTs}|Acc]); +decorate_tuple_sets([ArTup|List], L, Opaques, Acc) -> + decorate_tuple_sets(List, L, Opaques, [ArTup|Acc]); +decorate_tuple_sets([], _L, _Opaques, Acc) -> + ?tuple_set(lists:reverse(Acc)). + +decorate_tuples_in_sets([?tuple(Elements, _, ?any)], Ts, Opaques) -> + NewList = [list_decorate(Elements, Es, Opaques) || ?tuple(Es, _, _) <- Ts], + case t_sup([t_tuple(Es) || Es <- NewList]) of + ?tuple_set([{_Arity, Tuples}]) -> Tuples; + ?tuple(_, _, _)=Tuple -> [Tuple] + end; +decorate_tuples_in_sets(Tuples, Ts, Opaques) -> + decorate_tuples_in_sets(Tuples, Ts, Opaques, []). + +decorate_tuples_in_sets([?tuple(Elements, Arity, Tag1) = T1|Tuples] = L1, + [?tuple(Es, Arity, Tag2)|Ts] = L2, Opaques, Acc) -> + if + Tag1 < Tag2 -> decorate_tuples_in_sets(Tuples, L2, Opaques, [T1|Acc]); + Tag1 > Tag2 -> decorate_tuples_in_sets(L1, Ts, Opaques, Acc); + Tag1 =:= Tag2 -> + NewElements = list_decorate(Elements, Es, Opaques), + NewAcc = [?tuple(NewElements, Arity, Tag1)|Acc], + decorate_tuples_in_sets(Tuples, Ts, Opaques, NewAcc) + end; +decorate_tuples_in_sets([T1|Tuples], L2, Opaques, Acc) -> + decorate_tuples_in_sets(Tuples, L2, Opaques, [T1|Acc]); +decorate_tuples_in_sets([], _L, _Opaques, Acc) -> + lists:reverse(Acc). + +-spec t_opaque_from_records(type_table()) -> [erl_type()]. t_opaque_from_records(RecDict) -> OpaqueRecDict = @@ -549,54 +754,18 @@ t_opaque_from_records(RecDict) -> end end, RecDict), OpaqueTypeDict = - dict:map(fun({opaque, Name, _Arity}, {Module, Type, ArgNames}) -> - case ArgNames of - [] -> - t_opaque(Module, Name, [], t_from_form(Type, RecDict)); - _ -> - throw({error,"Polymorphic opaque types not supported yet"}) - end + dict:map(fun({opaque, Name, _Arity}, + {{Module, _FileLine, _Form, ArgNames}, _Type}) -> + %% Args = args_to_types(ArgNames), + %% List = lists:zip(ArgNames, Args), + %% TmpVarTab = maps:to_list(List), + %% Rep = t_from_form(Type, RecDict, TmpVarTab), + Rep = t_any(), % not used for anything right now + Args = [t_any() || _ <- ArgNames], + t_opaque(Module, Name, Args, Rep) end, OpaqueRecDict), [OpaqueType || {_Key, OpaqueType} <- dict:to_list(OpaqueTypeDict)]. --spec t_opaque_match_atom(erl_type(), [erl_type()]) -> [erl_type()]. - -t_opaque_match_atom(?atom(_) = Atom, Opaques) -> - case t_atom_vals(Atom) of - unknown -> []; - _ -> [O || O <- Opaques, t_inf(Atom, O, opaque) =/= ?none, - t_opaque_atom_vals(t_opaque_structure(O)) =/= unknown] - end; -t_opaque_match_atom(_, _) -> []. - --spec t_opaque_atom_vals(erl_type()) -> 'unknown' | [atom(),...]. - -t_opaque_atom_vals(OpaqueStruct) -> - case OpaqueStruct of - ?atom(_) -> t_atom_vals(OpaqueStruct); - ?union([Atom,_,_,_,_,_,_,_,_,_]) -> t_atom_vals(Atom); - _ -> unknown - end. - --spec t_opaque_match_record(erl_type(), [erl_type()]) -> [erl_type()]. - -t_opaque_match_record(?tuple([?atom(_) = Tag|_Fields], _, _) = Rec, Opaques) -> - [O || O <- Opaques, t_inf(Rec, O, opaque) =/= ?none, - lists:member(Tag, t_opaque_tuple_tags(t_opaque_structure(O)))]; -t_opaque_match_record(_, _) -> []. - --spec t_opaque_tuple_tags(erl_type()) -> [erl_type()]. - -t_opaque_tuple_tags(OpaqueStruct) -> - case OpaqueStruct of - ?tuple([?atom(_) = Tag|_Fields], _, _) -> [Tag]; - ?tuple_set(_) = TupleSet -> - Tuples = t_tuple_subtypes(TupleSet), - lists:flatten([t_opaque_tuple_tags(T) || T <- Tuples]); - ?union([_,_,_,_,_,_,Tuples,_,_,_]) -> t_opaque_tuple_tags(Tuples); - _ -> [] - end. - %% Decompose opaque instances of type arg2 to structured types, in arg1 %% XXX: Same as t_unopaque -spec t_struct_from_opaque(erl_type(), [erl_type()]) -> erl_type(). @@ -605,9 +774,10 @@ t_struct_from_opaque(?function(Domain, Range), Opaques) -> ?function(t_struct_from_opaque(Domain, Opaques), t_struct_from_opaque(Range, Opaques)); t_struct_from_opaque(?list(Types, Term, Size), Opaques) -> - ?list(t_struct_from_opaque(Types, Opaques), Term, Size); + ?list(t_struct_from_opaque(Types, Opaques), + t_struct_from_opaque(Term, Opaques), Size); t_struct_from_opaque(?opaque(_) = T, Opaques) -> - case lists:member(T, Opaques) of + case is_opaque_type(T, Opaques) of true -> t_opaque_structure(T); false -> T end; @@ -627,163 +797,9 @@ t_struct_from_opaque(Type, _Opaques) -> Type. list_struct_from_opaque(Types, Opaques) -> [t_struct_from_opaque(Type, Opaques) || Type <- Types]. --spec t_unopaque_on_mismatch(erl_type(), erl_type(), [erl_type()]) -> erl_type(). - -t_unopaque_on_mismatch(GenType, Type, Opaques) -> - case t_inf(GenType, Type) of - ?none -> - Unopaqued = t_unopaque(Type, Opaques), - %% XXX: Unions might be a problem, must investigate. - case t_inf(GenType, Unopaqued) of - ?none -> Type; - _ -> Unopaqued - end; - _ -> Type - end. - --spec module_builtin_opaques(module()) -> [erl_type()]. - -module_builtin_opaques(Module) -> - [O || O <- all_opaque_builtins(), t_opaque_module(O) =:= Module]. - %%----------------------------------------------------------------------------- -%% Remote types: these types are used for preprocessing; -%% they should never reach the analysis stage. - --spec t_remote(atom(), atom(), [erl_type()]) -> erl_type(). - -t_remote(Mod, Name, Args) -> - ?remote(set_singleton(#remote{mod = Mod, name = Name, args = Args})). - --spec t_is_remote(erl_type()) -> boolean(). - -t_is_remote(?remote(_)) -> true; -t_is_remote(_) -> false. - --spec t_solve_remote(erl_type(), set(), dict()) -> erl_type(). - -t_solve_remote(Type, ExpTypes, Records) -> - {RT, _RR} = t_solve_remote(Type, ExpTypes, Records, []), - RT. - -t_solve_remote(?function(Domain, Range), ET, R, C) -> - {RT1, RR1} = t_solve_remote(Domain, ET, R, C), - {RT2, RR2} = t_solve_remote(Range, ET, R, C), - {?function(RT1, RT2), RR1 ++ RR2}; -t_solve_remote(?list(Types, Term, Size), ET, R, C) -> - {RT, RR} = t_solve_remote(Types, ET, R, C), - {?list(RT, Term, Size), RR}; -t_solve_remote(?product(Types), ET, R, C) -> - {RL, RR} = list_solve_remote(Types, ET, R, C), - {?product(RL), RR}; -t_solve_remote(?opaque(Set), ET, R, C) -> - List = ordsets:to_list(Set), - {NewList, RR} = opaques_solve_remote(List, ET, R, C), - {?opaque(ordsets:from_list(NewList)), RR}; -t_solve_remote(?tuple(?any, _, _) = T, _ET, _R, _C) -> {T, []}; -t_solve_remote(?tuple(Types, _Arity, _Tag), ET, R, C) -> - {RL, RR} = list_solve_remote(Types, ET, R, C), - {t_tuple(RL), RR}; -t_solve_remote(?tuple_set(Set), ET, R, C) -> - {NewTuples, RR} = tuples_solve_remote(Set, ET, R, C), - {t_sup(NewTuples), RR}; -t_solve_remote(?remote(Set), ET, R, C) -> - RemoteList = ordsets:to_list(Set), - {RL, RR} = list_solve_remote_type(RemoteList, ET, R, C), - {t_sup(RL), RR}; -t_solve_remote(?union(List), ET, R, C) -> - {RL, RR} = list_solve_remote(List, ET, R, C), - {t_sup(RL), RR}; -t_solve_remote(T, _ET, _R, _C) -> {T, []}. - -t_solve_remote_type(#remote{mod = RemMod, name = Name, args = Args} = RemType, - ET, R, C) -> - ArgsLen = length(Args), - case dict:find(RemMod, R) of - error -> - self() ! {self(), ext_types, {RemMod, Name, ArgsLen}}, - {t_any(), []}; - {ok, RemDict} -> - MFA = {RemMod, Name, ArgsLen}, - case sets:is_element(MFA, ET) of - true -> - case lookup_type(Name, ArgsLen, RemDict) of - {type, {_Mod, Type, ArgNames}} -> - {NewType, NewCycle, NewRR} = - case can_unfold_more(RemType, C) of - true -> - List = lists:zip(ArgNames, Args), - TmpVarDict = dict:from_list(List), - {t_from_form(Type, RemDict, TmpVarDict), [RemType|C], []}; - false -> - {t_any(), C, [RemType]} - end, - {RT, RR} = t_solve_remote(NewType, ET, R, NewCycle), - RetRR = NewRR ++ RR, - RT1 = - case lists:member(RemType, RetRR) of - true -> t_limit(RT, ?REC_TYPE_LIMIT); - false -> RT - end, - {RT1, RetRR}; - {opaque, {Mod, Type, ArgNames}} -> - List = lists:zip(ArgNames, Args), - TmpVarDict = dict:from_list(List), - {Rep, NewCycle, NewRR} = - case can_unfold_more(RemType, C) of - true -> - {t_from_form(Type, RemDict, TmpVarDict), [RemType|C], []}; - false -> - {t_any(), C, [RemType]} - end, - {NewRep, RR} = t_solve_remote(Rep, ET, R, NewCycle), - RetRR = NewRR ++ RR, - RT1 = - case lists:member(RemType, RetRR) of - true -> t_limit(NewRep, ?REC_TYPE_LIMIT); - false -> NewRep - end, - {t_from_form({opaque, -1, Name, {Mod, Args, RT1}}, - RemDict, TmpVarDict), - RetRR}; - error -> - Msg = io_lib:format("Unable to find remote type ~w:~w()\n", - [RemMod, Name]), - throw({error, Msg}) - end; - false -> - self() ! {self(), ext_types, {RemMod, Name, ArgsLen}}, - {t_any(), []} - end - end. -list_solve_remote([], _ET, _R, _C) -> - {[], []}; -list_solve_remote([Type|Types], ET, R, C) -> - {RT, RR1} = t_solve_remote(Type, ET, R, C), - {RL, RR2} = list_solve_remote(Types, ET, R, C), - {[RT|RL], RR1 ++ RR2}. - -list_solve_remote_type([], _ET, _R, _C) -> - {[], []}; -list_solve_remote_type([Type|Types], ET, R, C) -> - {RT, RR1} = t_solve_remote_type(Type, ET, R, C), - {RL, RR2} = list_solve_remote_type(Types, ET, R, C), - {[RT|RL], RR1 ++ RR2}. - -opaques_solve_remote([], _ET, _R, _C) -> - {[], []}; -opaques_solve_remote([#opaque{struct = Struct} = Remote|Tail], ET, R, C) -> - {RT, RR1} = t_solve_remote(Struct, ET, R, C), - {LOp, RR2} = opaques_solve_remote(Tail, ET, R, C), - {[Remote#opaque{struct = RT}|LOp], RR1 ++ RR2}. - -tuples_solve_remote([], _ET, _R, _C) -> - {[], []}; -tuples_solve_remote([{_Sz, Tuples}|Tail], ET, R, C) -> - {RL, RR1} = list_solve_remote(Tuples, ET, R, C), - {LSzTpls, RR2} = tuples_solve_remote(Tail, ET, R, C), - {RL ++ LSzTpls, RR1 ++ RR2}. +-type mod_records() :: dict:dict(module(), type_table()). %%----------------------------------------------------------------------------- %% Unit type. Signals non termination. @@ -826,40 +842,75 @@ t_atoms(List) when is_list(List) -> -spec t_atom_vals(erl_type()) -> 'unknown' | [atom(),...]. -t_atom_vals(?atom(?any)) -> unknown; -t_atom_vals(?atom(Set)) -> set_to_list(Set); -t_atom_vals(Other) -> +t_atom_vals(Type) -> + t_atom_vals(Type, 'universe'). + +-spec t_atom_vals(erl_type(), opaques()) -> 'unknown' | [atom(),...]. + +t_atom_vals(Type, Opaques) -> + do_opaque(Type, Opaques, fun atom_vals/1). + +atom_vals(?atom(?any)) -> unknown; +atom_vals(?atom(Set)) -> set_to_list(Set); +atom_vals(?opaque(_)) -> unknown; +atom_vals(Other) -> ?atom(_) = Atm = t_inf(t_atom(), Other), - t_atom_vals(Atm). + atom_vals(Atm). -spec t_is_atom(erl_type()) -> boolean(). -t_is_atom(?atom(_)) -> true; -t_is_atom(_) -> false. +t_is_atom(Type) -> + t_is_atom(Type, 'universe'). + +-spec t_is_atom(erl_type(), opaques()) -> boolean(). + +t_is_atom(Type, Opaques) -> + do_opaque(Type, Opaques, fun is_atom1/1). + +is_atom1(?atom(_)) -> true; +is_atom1(_) -> false. + +-spec t_is_any_atom(atom(), erl_type()) -> boolean(). --spec t_is_atom(atom(), erl_type()) -> boolean(). +t_is_any_atom(Atom, SomeAtomsType) -> + t_is_any_atom(Atom, SomeAtomsType, 'universe'). -t_is_atom(Atom, ?atom(?any)) when is_atom(Atom) -> false; -t_is_atom(Atom, ?atom(Set)) when is_atom(Atom) -> set_is_singleton(Atom, Set); -t_is_atom(Atom, _) when is_atom(Atom) -> false. +-spec t_is_any_atom(atom(), erl_type(), opaques()) -> boolean(). + +t_is_any_atom(Atom, SomeAtomsType, Opaques) -> + do_opaque(SomeAtomsType, Opaques, + fun(AtomsType) -> is_any_atom(Atom, AtomsType) end). + +is_any_atom(Atom, ?atom(?any)) when is_atom(Atom) -> false; +is_any_atom(Atom, ?atom(Set)) when is_atom(Atom) -> + set_is_singleton(Atom, Set); +is_any_atom(Atom, _) when is_atom(Atom) -> false. %%------------------------------------ +-spec t_is_boolean(erl_type()) -> boolean(). + +t_is_boolean(Type) -> + t_is_boolean(Type, 'universe'). + +-spec t_is_boolean(erl_type(), opaques()) -> boolean(). + +t_is_boolean(Type, Opaques) -> + do_opaque(Type, Opaques, fun is_boolean/1). + -spec t_boolean() -> erl_type(). t_boolean() -> ?atom(set_from_list([false, true])). --spec t_is_boolean(erl_type()) -> boolean(). - -t_is_boolean(?atom(?any)) -> false; -t_is_boolean(?atom(Set)) -> +is_boolean(?atom(?any)) -> false; +is_boolean(?atom(Set)) -> case set_size(Set) of 1 -> set_is_element(true, Set) orelse set_is_element(false, Set); 2 -> set_is_element(true, Set) andalso set_is_element(false, Set); N when is_integer(N), N > 2 -> false end; -t_is_boolean(_) -> false. +is_boolean(_) -> false. %%----------------------------------------------------------------------------- %% Binaries @@ -872,9 +923,17 @@ t_binary() -> -spec t_is_binary(erl_type()) -> boolean(). -t_is_binary(?bitstr(U, B)) -> +t_is_binary(Type) -> + t_is_binary(Type, 'universe'). + +-spec t_is_binary(erl_type(), opaques()) -> boolean(). + +t_is_binary(Type, Opaques) -> + do_opaque(Type, Opaques, fun is_binary/1). + +is_binary(?bitstr(U, B)) -> ((U rem 8) =:= 0) andalso ((B rem 8) =:= 0); -t_is_binary(_) -> false. +is_binary(_) -> false. %%----------------------------------------------------------------------------- %% Bitstrings @@ -921,19 +980,27 @@ t_bitstr_concat_1([], Acc) -> t_bitstr_concat(T1, T2) -> T1p = t_inf(t_bitstr(), T1), T2p = t_inf(t_bitstr(), T2), - bitstr_concat(T1p, T2p). + bitstr_concat(t_unopaque(T1p), t_unopaque(T2p)). -spec t_bitstr_match(erl_type(), erl_type()) -> erl_type(). t_bitstr_match(T1, T2) -> T1p = t_inf(t_bitstr(), T1), T2p = t_inf(t_bitstr(), T2), - bitstr_match(T1p, T2p). + bitstr_match(t_unopaque(T1p), t_unopaque(T2p)). -spec t_is_bitstr(erl_type()) -> boolean(). -t_is_bitstr(?bitstr(_, _)) -> true; -t_is_bitstr(_) -> false. +t_is_bitstr(Type) -> + t_is_bitstr(Type, 'universe'). + +-spec t_is_bitstr(erl_type(), opaques()) -> boolean(). + +t_is_bitstr(Type, Opaques) -> + do_opaque(Type, Opaques, fun is_bitstr/1). + +is_bitstr(?bitstr(_, _)) -> true; +is_bitstr(_) -> false. %%----------------------------------------------------------------------------- %% Matchstates @@ -1044,27 +1111,59 @@ t_fun(Arity, Range) when is_integer(Arity), 0 =< Arity, Arity =< 255 -> -spec t_fun_args(erl_type()) -> 'unknown' | [erl_type()]. -t_fun_args(?function(?any, _)) -> +t_fun_args(Type) -> + t_fun_args(Type, 'universe'). + +-spec t_fun_args(erl_type(), opaques()) -> 'unknown' | [erl_type()]. + +t_fun_args(Type, Opaques) -> + do_opaque(Type, Opaques, fun fun_args/1). + +fun_args(?function(?any, _)) -> unknown; -t_fun_args(?function(?product(Domain), _)) when is_list(Domain) -> +fun_args(?function(?product(Domain), _)) when is_list(Domain) -> Domain. -spec t_fun_arity(erl_type()) -> 'unknown' | non_neg_integer(). -t_fun_arity(?function(?any, _)) -> +t_fun_arity(Type) -> + t_fun_arity(Type, 'universe'). + +-spec t_fun_arity(erl_type(), opaques()) -> 'unknown' | non_neg_integer(). + +t_fun_arity(Type, Opaques) -> + do_opaque(Type, Opaques, fun fun_arity/1). + +fun_arity(?function(?any, _)) -> unknown; -t_fun_arity(?function(?product(Domain), _)) -> +fun_arity(?function(?product(Domain), _)) -> length(Domain). -spec t_fun_range(erl_type()) -> erl_type(). -t_fun_range(?function(_, Range)) -> +t_fun_range(Type) -> + t_fun_range(Type, 'universe'). + +-spec t_fun_range(erl_type(), opaques()) -> erl_type(). + +t_fun_range(Type, Opaques) -> + do_opaque(Type, Opaques, fun fun_range/1). + +fun_range(?function(_, Range)) -> Range. -spec t_is_fun(erl_type()) -> boolean(). -t_is_fun(?function(_, _)) -> true; -t_is_fun(_) -> false. +t_is_fun(Type) -> + t_is_fun(Type, 'universe'). + +-spec t_is_fun(erl_type(), opaques()) -> boolean(). + +t_is_fun(Type, Opaques) -> + do_opaque(Type, Opaques, fun is_fun/1). + +is_fun(?function(_, _)) -> true; +is_fun(_) -> false. %%----------------------------------------------------------------------------- %% Identifiers. Includes ports, pids and refs. @@ -1091,9 +1190,17 @@ t_port() -> -spec t_is_port(erl_type()) -> boolean(). -t_is_port(?identifier(?any)) -> false; -t_is_port(?identifier(Set)) -> set_is_singleton(?port_qual, Set); -t_is_port(_) -> false. +t_is_port(Type) -> + t_is_port(Type, 'universe'). + +-spec t_is_port(erl_type(), opaques()) -> boolean(). + +t_is_port(Type, Opaques) -> + do_opaque(Type, Opaques, fun is_port1/1). + +is_port1(?identifier(?any)) -> false; +is_port1(?identifier(Set)) -> set_is_singleton(?port_qual, Set); +is_port1(_) -> false. %%------------------------------------ @@ -1104,9 +1211,17 @@ t_pid() -> -spec t_is_pid(erl_type()) -> boolean(). -t_is_pid(?identifier(?any)) -> false; -t_is_pid(?identifier(Set)) -> set_is_singleton(?pid_qual, Set); -t_is_pid(_) -> false. +t_is_pid(Type) -> + t_is_pid(Type, 'universe'). + +-spec t_is_pid(erl_type(), opaques()) -> boolean(). + +t_is_pid(Type, Opaques) -> + do_opaque(Type, Opaques, fun is_pid1/1). + +is_pid1(?identifier(?any)) -> false; +is_pid1(?identifier(Set)) -> set_is_singleton(?pid_qual, Set); +is_pid1(_) -> false. %%------------------------------------ @@ -1117,9 +1232,17 @@ t_reference() -> -spec t_is_reference(erl_type()) -> boolean(). -t_is_reference(?identifier(?any)) -> false; -t_is_reference(?identifier(Set)) -> set_is_singleton(?reference_qual, Set); -t_is_reference(_) -> false. +t_is_reference(Type) -> + t_is_reference(Type, 'universe'). + +-spec t_is_reference(erl_type(), opaques()) -> boolean(). + +t_is_reference(Type, Opaques) -> + do_opaque(Type, Opaques, fun is_reference1/1). + +is_reference1(?identifier(?any)) -> false; +is_reference1(?identifier(Set)) -> set_is_singleton(?reference_qual, Set); +is_reference1(_) -> false. %%----------------------------------------------------------------------------- %% Numbers are divided into floats, integers, chars and bytes. @@ -1137,21 +1260,38 @@ t_number(X) when is_integer(X) -> -spec t_is_number(erl_type()) -> boolean(). -t_is_number(?number(_, _)) -> true; -t_is_number(_) -> false. +t_is_number(Type) -> + t_is_number(Type, 'universe'). + +-spec t_is_number(erl_type(), opaques()) -> boolean(). + +t_is_number(Type, Opaques) -> + do_opaque(Type, Opaques, fun is_number/1). + +is_number(?number(_, _)) -> true; +is_number(_) -> false. %% Currently, the type system collapses all floats to ?float and does %% not keep any information about their values. As a result, the list %% that this function returns contains only integers. + -spec t_number_vals(erl_type()) -> 'unknown' | [integer(),...]. -t_number_vals(?int_set(?any)) -> unknown; -t_number_vals(?int_set(Set)) -> set_to_list(Set); -t_number_vals(?number(_, _)) -> unknown; -t_number_vals(Other) -> +t_number_vals(Type) -> + t_number_vals(Type, 'universe'). + +-spec t_number_vals(erl_type(), opaques()) -> 'unknown' | [integer(),...]. + +t_number_vals(Type, Opaques) -> + do_opaque(Type, Opaques, fun number_vals/1). + +number_vals(?int_set(Set)) -> set_to_list(Set); +number_vals(?number(_, _)) -> unknown; +number_vals(?opaque(_)) -> unknown; +number_vals(Other) -> Inf = t_inf(Other, t_number()), false = t_is_none(Inf), % sanity check - t_number_vals(Inf). + number_vals(Inf). %%------------------------------------ @@ -1162,8 +1302,16 @@ t_float() -> -spec t_is_float(erl_type()) -> boolean(). -t_is_float(?float) -> true; -t_is_float(_) -> false. +t_is_float(Type) -> + t_is_float(Type, 'universe'). + +-spec t_is_float(erl_type(), opaques()) -> boolean(). + +t_is_float(Type, Opaques) -> + do_opaque(Type, Opaques, fun is_float1/1). + +is_float1(?float) -> true; +is_float1(_) -> false. %%------------------------------------ @@ -1184,8 +1332,16 @@ t_integers(List) when is_list(List) -> -spec t_is_integer(erl_type()) -> boolean(). -t_is_integer(?integer(_)) -> true; -t_is_integer(_) -> false. +t_is_integer(Type) -> + t_is_integer(Type, 'universe'). + +-spec t_is_integer(erl_type(), opaques()) -> boolean(). + +t_is_integer(Type, Opaques) -> + do_opaque(Type, Opaques, fun is_integer1/1). + +is_integer1(?integer(_)) -> true; +is_integer1(_) -> false. %%------------------------------------ @@ -1249,7 +1405,7 @@ t_cons(Hd, ?nil) -> t_cons(Hd, ?list(Contents, Termination, _)) -> ?nonempty_list(t_sup(Contents, Hd), Termination); t_cons(Hd, Tail) -> - case t_inf(Tail, t_maybe_improper_list()) of + case cons_tail(t_inf(Tail, t_maybe_improper_list())) of ?list(Contents, Termination, _Size) -> %% Collapse the list part of the termination but keep the %% non-list part intact. @@ -1261,18 +1417,45 @@ t_cons(Hd, Tail) -> ?unit -> ?none end. +cons_tail(Type) -> + do_opaque(Type, 'universe', fun(T) -> T end). + -spec t_is_cons(erl_type()) -> boolean(). -t_is_cons(?nonempty_list(_, _)) -> true; -t_is_cons(_) -> false. +t_is_cons(Type) -> + t_is_cons(Type, 'universe'). + +-spec t_is_cons(erl_type(), opaques()) -> boolean(). + +t_is_cons(Type, Opaques) -> + do_opaque(Type, Opaques, fun is_cons/1). + +is_cons(?nonempty_list(_, _)) -> true; +is_cons(_) -> false. -spec t_cons_hd(erl_type()) -> erl_type(). -t_cons_hd(?nonempty_list(Contents, _Termination)) -> Contents. +t_cons_hd(Type) -> + t_cons_hd(Type, 'universe'). + +-spec t_cons_hd(erl_type(), opaques()) -> erl_type(). + +t_cons_hd(Type, Opaques) -> + do_opaque(Type, Opaques, fun cons_hd/1). + +cons_hd(?nonempty_list(Contents, _Termination)) -> Contents. -spec t_cons_tl(erl_type()) -> erl_type(). -t_cons_tl(?nonempty_list(_Contents, Termination) = T) -> +t_cons_tl(Type) -> + t_cons_tl(Type, 'universe'). + +-spec t_cons_tl(erl_type(), opaques()) -> erl_type(). + +t_cons_tl(Type, Opaques) -> + do_opaque(Type, Opaques, fun cons_tl/1). + +cons_tl(?nonempty_list(_Contents, Termination) = T) -> t_sup(Termination, T). -spec t_nil() -> erl_type(). @@ -1282,8 +1465,16 @@ t_nil() -> -spec t_is_nil(erl_type()) -> boolean(). -t_is_nil(?nil) -> true; -t_is_nil(_) -> false. +t_is_nil(Type) -> + t_is_nil(Type, 'universe'). + +-spec t_is_nil(erl_type(), opaques()) -> boolean(). + +t_is_nil(Type, Opaques) -> + do_opaque(Type, Opaques, fun is_nil/1). + +is_nil(?nil) -> true; +is_nil(_) -> false. -spec t_list() -> erl_type(). @@ -1299,8 +1490,21 @@ t_list(Contents) -> -spec t_list_elements(erl_type()) -> erl_type(). -t_list_elements(?list(Contents, _, _)) -> Contents; -t_list_elements(?nil) -> ?none. +t_list_elements(Type) -> + t_list_elements(Type, 'universe'). + +-spec t_list_elements(erl_type(), opaques()) -> erl_type(). + +t_list_elements(Type, Opaques) -> + do_opaque(Type, Opaques, fun list_elements/1). + +list_elements(?list(Contents, _, _)) -> Contents; +list_elements(?nil) -> ?none. + +-spec t_list_termination(erl_type(), opaques()) -> erl_type(). + +t_list_termination(Type, Opaques) -> + do_opaque(Type, Opaques, fun t_list_termination/1). -spec t_list_termination(erl_type()) -> erl_type(). @@ -1349,15 +1553,23 @@ t_maybe_improper_list() -> t_maybe_improper_list(_Content, ?unit) -> ?none; t_maybe_improper_list(?unit, _Termination) -> ?none; t_maybe_improper_list(Content, Termination) -> - %% Safety check - true = t_is_subtype(t_nil(), Termination), + %% Safety check: would be nice to have but does not work with remote types + %% true = t_is_subtype(t_nil(), Termination), ?list(Content, Termination, ?unknown_qual). -spec t_is_maybe_improper_list(erl_type()) -> boolean(). -t_is_maybe_improper_list(?list(_, _, _)) -> true; -t_is_maybe_improper_list(?nil) -> true; -t_is_maybe_improper_list(_) -> false. +t_is_maybe_improper_list(Type) -> + t_is_maybe_improper_list(Type, 'universe'). + +-spec t_is_maybe_improper_list(erl_type(), opaques()) -> boolean(). + +t_is_maybe_improper_list(Type, Opaques) -> + do_opaque(Type, Opaques, fun is_maybe_improper_list/1). + +is_maybe_improper_list(?list(_, _, _)) -> true; +is_maybe_improper_list(?nil) -> true; +is_maybe_improper_list(_) -> false. %% %% Should only be used if you know what you are doing. See t_cons/2 %% -spec t_improper_list(erl_type(), erl_type()) -> erl_type(). @@ -1365,10 +1577,15 @@ t_is_maybe_improper_list(_) -> false. %% t_improper_list(?unit, _Termination) -> ?none; %% t_improper_list(_Content, ?unit) -> ?none; %% t_improper_list(Content, Termination) -> -%% %% Safety check -%% false = t_is_subtype(t_nil(), Termination), +%% %% Safety check: would be nice to have but does not work with remote types +%% %% false = t_is_subtype(t_nil(), Termination), %% ?list(Content, Termination, ?any). +-spec lift_list_to_pos_empty(erl_type(), opaques()) -> erl_type(). + +lift_list_to_pos_empty(Type, Opaques) -> + do_opaque(Type, Opaques, fun lift_list_to_pos_empty/1). + -spec lift_list_to_pos_empty(erl_type()) -> erl_type(). lift_list_to_pos_empty(?nil) -> ?nil; @@ -1376,6 +1593,361 @@ lift_list_to_pos_empty(?list(Content, Termination, _)) -> ?list(Content, Termination, ?unknown_qual). %%----------------------------------------------------------------------------- +%% Maps +%% +%% Representation: +%% ?map(Pairs, DefaultKey, DefaultValue) +%% +%% Pairs is a sorted dictionary of types with a mandatoriness tag on each pair +%% (t_map_dict()). DefaultKey and DefaultValue are plain types. +%% +%% A map M belongs to this type iff +%% For each pair {KT, mandatory, VT} in Pairs, there exists a pair {K, V} in M +%% such that K \in KT and V \in VT. +%% For each pair {KT, optional, VT} in Pairs, either there exists no key K in +%% M s.t. K in KT, or there exists a pair {K, V} in M such that K \in KT and +%% V \in VT. +%% For each remaining pair {K, V} in M (where remaining means that there is no +%% key KT in Pairs s.t. K \in KT), K \in DefaultKey and V \in DefaultValue. +%% +%% Invariants: +%% * The keys in Pairs are singleton types. +%% * The values of Pairs must not be unit, and may only be none if the +%% mandatoriness tag is 'optional'. +%% * Optional must contain no pair {K,V} s.t. K is a subtype of DefaultKey and +%% V is equal to DefaultKey. +%% * DefaultKey must be the empty type iff DefaultValue is the empty type. +%% * DefaultKey must not be a singleton type. +%% * For every key K in Pairs, DefaultKey - K must not be representable; i.e. +%% t_subtract(DefaultKey, K) must return DefaultKey. +%% * For every pair {K, 'optional', ?none} in Pairs, K must be a subtype of +%% DefaultKey. +%% * Pairs must be sorted and not contain any duplicate keys. +%% +%% These invariants ensure that equal map types are represented by equal terms. + +-define(mand, mandatory). +-define(opt, optional). + +-type t_map_mandatoriness() :: ?mand | ?opt. +-type t_map_pair() :: {erl_type(), t_map_mandatoriness(), erl_type()}. +-type t_map_dict() :: [t_map_pair()]. + +-spec t_map() -> erl_type(). + +t_map() -> + t_map([], t_any(), t_any()). + +-spec t_map([{erl_type(), erl_type()}]) -> erl_type(). + +t_map(L) -> + lists:foldl(fun t_map_put/2, t_map(), L). + +-spec t_map(t_map_dict(), erl_type(), erl_type()) -> erl_type(). + +t_map(Pairs0, DefK0, DefV0) -> + DefK1 = lists:foldl(fun({K,_,_},Acc)->t_subtract(Acc,K)end, DefK0, Pairs0), + {DefK2, DefV1} = + case t_is_none_or_unit(DefK1) orelse t_is_none_or_unit(DefV0) of + true -> {?none, ?none}; + false -> {DefK1, DefV0} + end, + {Pairs1, DefK, DefV} + = case is_singleton_type(DefK2) of + true -> {mapdict_insert({DefK2, ?opt, DefV1}, Pairs0), ?none, ?none}; + false -> {Pairs0, DefK2, DefV1} + end, + Pairs = normalise_map_optionals(Pairs1, DefK, DefV), + %% Validate invariants of the map representation. + %% Since we needed to iterate over the arguments in order to normalise anyway, + %% we might as well save us some future pain and do this even without + %% define(DEBUG, true). + try + validate_map_elements(Pairs) + catch error:badarg -> error(badarg, [Pairs0,DefK0,DefV0]); + error:{badarg, E} -> error({badarg, E}, [Pairs0,DefK0,DefV0]) + end, + ?map(Pairs, DefK, DefV). + +normalise_map_optionals([], _, _) -> []; +normalise_map_optionals([E={K,?opt,?none}|T], DefK, DefV) -> + Diff = t_subtract(DefK, K), + case t_is_subtype(K, DefK) andalso DefK =:= Diff of + true -> [E|normalise_map_optionals(T, DefK, DefV)]; + false -> normalise_map_optionals(T, Diff, DefV) + end; +normalise_map_optionals([E={K,?opt,V}|T], DefK, DefV) -> + case t_is_equal(V, DefV) andalso t_is_subtype(K, DefK) of + true -> normalise_map_optionals(T, DefK, DefV); + false -> [E|normalise_map_optionals(T, DefK, DefV)] + end; +normalise_map_optionals([E|T], DefK, DefV) -> + [E|normalise_map_optionals(T, DefK, DefV)]. + +validate_map_elements([{_,?mand,?none}|_]) -> error({badarg, none_in_mand}); +validate_map_elements([{K1,_,_}|Rest=[{K2,_,_}|_]]) -> + case is_singleton_type(K1) andalso K1 < K2 of + false -> error(badarg); + true -> validate_map_elements(Rest) + end; +validate_map_elements([{K,_,_}]) -> + case is_singleton_type(K) of + false -> error(badarg); + true -> true + end; +validate_map_elements([]) -> true. + +-spec t_is_map(erl_type()) -> boolean(). + +t_is_map(Type) -> + t_is_map(Type, 'universe'). + +-spec t_is_map(erl_type(), opaques()) -> boolean(). + +t_is_map(Type, Opaques) -> + do_opaque(Type, Opaques, fun is_map1/1). + +is_map1(?map(_, _, _)) -> true; +is_map1(_) -> false. + +-spec t_map_entries(erl_type()) -> t_map_dict(). + +t_map_entries(M) -> + t_map_entries(M, 'universe'). + +-spec t_map_entries(erl_type(), opaques()) -> t_map_dict(). + +t_map_entries(M, Opaques) -> + do_opaque(M, Opaques, fun map_entries/1). + +map_entries(?map(Pairs,_,_)) -> + Pairs. + +-spec t_map_def_key(erl_type()) -> erl_type(). + +t_map_def_key(M) -> + t_map_def_key(M, 'universe'). + +-spec t_map_def_key(erl_type(), opaques()) -> erl_type(). + +t_map_def_key(M, Opaques) -> + do_opaque(M, Opaques, fun map_def_key/1). + +map_def_key(?map(_,DefK,_)) -> + DefK. + +-spec t_map_def_val(erl_type()) -> erl_type(). + +t_map_def_val(M) -> + t_map_def_val(M, 'universe'). + +-spec t_map_def_val(erl_type(), opaques()) -> erl_type(). + +t_map_def_val(M, Opaques) -> + do_opaque(M, Opaques, fun map_def_val/1). + +map_def_val(?map(_,_,DefV)) -> + DefV. + +-spec mapdict_store(t_map_pair(), t_map_dict()) -> t_map_dict(). + +mapdict_store(E={K,_,_}, [{K,_,_}|T]) -> [E|T]; +mapdict_store(E1={K1,_,_}, [E2={K2,_,_}|T]) when K1 > K2 -> + [E2|mapdict_store(E1, T)]; +mapdict_store(E={_,_,_}, T) -> [E|T]. + +-spec mapdict_insert(t_map_pair(), t_map_dict()) -> t_map_dict(). + +mapdict_insert(E={K,_,_}, D=[{K,_,_}|_]) -> error(badarg, [E, D]); +mapdict_insert(E1={K1,_,_}, [E2={K2,_,_}|T]) when K1 > K2 -> + [E2|mapdict_insert(E1, T)]; +mapdict_insert(E={_,_,_}, T) -> [E|T]. + +%% Merges the pairs of two maps together. Missing pairs become (?opt, DefV) or +%% (?opt, ?none), depending on whether K \in DefK. +-spec map_pairwise_merge(fun((erl_type(), + t_map_mandatoriness(), erl_type(), + t_map_mandatoriness(), erl_type()) + -> t_map_pair() | false), + erl_type(), erl_type()) -> t_map_dict(). +map_pairwise_merge(F, ?map(APairs, ADefK, ADefV), + ?map(BPairs, BDefK, BDefV)) -> + map_pairwise_merge(F, APairs, ADefK, ADefV, BPairs, BDefK, BDefV). + +map_pairwise_merge(_, [], _, _, [], _, _) -> []; +map_pairwise_merge(F, As0, ADefK, ADefV, Bs0, BDefK, BDefV) -> + {K1, AMNess1, AV1, As1, BMNess1, BV1, Bs1} = + case {As0, Bs0} of + {[{K,AMNess,AV}|As], [{K, BMNess,BV}|Bs]} -> + {K, AMNess, AV, As, BMNess, BV, Bs}; + {[{K,AMNess,AV}|As], [{BK,_, _ }|_]=Bs} when K < BK -> + {K, AMNess, AV, As, ?opt, mapmerge_otherv(K, BDefK, BDefV), Bs}; + {As, [{K, BMNess,BV}|Bs]} -> + {K, ?opt, mapmerge_otherv(K, ADefK, ADefV), As, BMNess, BV, Bs}; + {[{K,AMNess,AV}|As], []=Bs} -> + {K, AMNess, AV, As, ?opt, mapmerge_otherv(K, BDefK, BDefV), Bs} + end, + MK = K1, %% Rename to make clear that we are matching below + case F(K1, AMNess1, AV1, BMNess1, BV1) of + false -> map_pairwise_merge(F,As1,ADefK,ADefV,Bs1,BDefK,BDefV); + {MK,_,_}=M -> [M|map_pairwise_merge(F,As1,ADefK,ADefV,Bs1,BDefK,BDefV)] + end. + +%% Folds over the pairs in two maps simultaneously in reverse key order. Missing +%% pairs become (?opt, DefV) or (?opt, ?none), depending on whether K \in DefK. +-spec map_pairwise_merge_foldr(fun((erl_type(), + t_map_mandatoriness(), erl_type(), + t_map_mandatoriness(), erl_type(), + Acc) -> Acc), + Acc, erl_type(), erl_type()) -> Acc. + +map_pairwise_merge_foldr(F, AccIn, ?map(APairs, ADefK, ADefV), + ?map(BPairs, BDefK, BDefV)) -> + map_pairwise_merge_foldr(F, AccIn, APairs, ADefK, ADefV, BPairs, BDefK, BDefV). + +map_pairwise_merge_foldr(_, Acc, [], _, _, [], _, _) -> Acc; +map_pairwise_merge_foldr(F, AccIn, As0, ADefK, ADefV, Bs0, BDefK, BDefV) -> + {K1, AMNess1, AV1, As1, BMNess1, BV1, Bs1} = + case {As0, Bs0} of + {[{K,AMNess,AV}|As], [{K,BMNess,BV}|Bs]} -> + {K, AMNess, AV, As, BMNess, BV, Bs}; + {[{K,AMNess,AV}|As], [{BK,_, _ }|_]=Bs} when K < BK -> + {K, AMNess, AV, As, ?opt, mapmerge_otherv(K, BDefK, BDefV), Bs}; + {As, [{K,BMNess,BV}|Bs]} -> + {K, ?opt, mapmerge_otherv(K, ADefK, ADefV), As, BMNess, BV, Bs}; + {[{K,AMNess,AV}|As], []=Bs} -> + {K, AMNess, AV, As, ?opt, mapmerge_otherv(K, BDefK, BDefV), Bs} + end, + F(K1, AMNess1, AV1, BMNess1, BV1, + map_pairwise_merge_foldr(F,AccIn,As1,ADefK,ADefV,Bs1,BDefK,BDefV)). + +%% By observing that a missing pair in a map is equivalent to an optional pair, +%% with ?none or DefV value, depending on whether K \in DefK, we can simplify +%% merging by denormalising the map pairs temporarily, removing all 'false' +%% cases, at the cost of the creation of more tuples: +mapmerge_otherv(K, ODefK, ODefV) -> + case t_inf(K, ODefK) of + ?none -> ?none; + _KOrOpaque -> ODefV + end. + +-spec t_map_put({erl_type(), erl_type()}, erl_type()) -> erl_type(). + +t_map_put(KV, Map) -> + t_map_put(KV, Map, 'universe'). + +-spec t_map_put({erl_type(), erl_type()}, erl_type(), opaques()) -> erl_type(). + +t_map_put(KV, Map, Opaques) -> + do_opaque(Map, Opaques, fun(UM) -> map_put(KV, UM, Opaques) end). + +%% Key and Value are *not* unopaqued, but the map is +map_put(_, ?none, _) -> ?none; +map_put({Key, Value}, ?map(Pairs,DefK,DefV), Opaques) -> + case t_is_none_or_unit(Key) orelse t_is_none_or_unit(Value) of + true -> ?none; + false -> + case is_singleton_type(Key) of + true -> + t_map(mapdict_store({Key, ?mand, Value}, Pairs), DefK, DefV); + false -> + t_map([{K, MNess, case t_is_none(t_inf(K, Key, Opaques)) of + true -> V; + false -> t_sup(V, Value) + end} || {K, MNess, V} <- Pairs], + t_sup(DefK, Key), + t_sup(DefV, Value)) + end + end. + +-spec t_map_update({erl_type(), erl_type()}, erl_type()) -> erl_type(). + +t_map_update(KV, Map) -> + t_map_update(KV, Map, 'universe'). + +-spec t_map_update({erl_type(), erl_type()}, erl_type(), opaques()) -> erl_type(). + +t_map_update(_, ?none, _) -> ?none; +t_map_update(KV={Key, _}, M, Opaques) -> + case t_is_subtype(t_atom('true'), t_map_is_key(Key, M, Opaques)) of + false -> ?none; + true -> t_map_put(KV, M, Opaques) + end. + +-spec t_map_get(erl_type(), erl_type()) -> erl_type(). + +t_map_get(Key, Map) -> + t_map_get(Key, Map, 'universe'). + +-spec t_map_get(erl_type(), erl_type(), opaques()) -> erl_type(). + +t_map_get(Key, Map, Opaques) -> + do_opaque(Map, Opaques, + fun(UM) -> + do_opaque(Key, Opaques, fun(UK) -> map_get(UK, UM) end) + end). + +map_get(_, ?none) -> ?none; +map_get(Key, ?map(Pairs, DefK, DefV)) -> + DefRes = + case t_do_overlap(DefK, Key) of + false -> t_none(); + true -> DefV + end, + case is_singleton_type(Key) of + false -> + lists:foldl(fun({K, _, V}, Res) -> + case t_do_overlap(K, Key) of + false -> Res; + true -> t_sup(Res, V) + end + end, DefRes, Pairs); + true -> + case lists:keyfind(Key, 1, Pairs) of + false -> DefRes; + {_, _, ValType} -> ValType + end + end. + +-spec t_map_is_key(erl_type(), erl_type()) -> erl_type(). + +t_map_is_key(Key, Map) -> + t_map_is_key(Key, Map, 'universe'). + +-spec t_map_is_key(erl_type(), erl_type(), opaques()) -> erl_type(). + +t_map_is_key(Key, Map, Opaques) -> + do_opaque(Map, Opaques, + fun(UM) -> + do_opaque(Key, Opaques, fun(UK) -> map_is_key(UK, UM) end) + end). + +map_is_key(_, ?none) -> ?none; +map_is_key(Key, ?map(Pairs, DefK, _DefV)) -> + case is_singleton_type(Key) of + true -> + case lists:keyfind(Key, 1, Pairs) of + {Key, ?mand, _} -> t_atom(true); + {Key, ?opt, ?none} -> t_atom(false); + {Key, ?opt, _} -> t_boolean(); + false -> + case t_do_overlap(DefK, Key) of + false -> t_atom(false); + true -> t_boolean() + end + end; + false -> + case t_do_overlap(DefK, Key) + orelse lists:any(fun({_,_,?none}) -> false; + ({K,_,_}) -> t_do_overlap(K, Key) + end, Pairs) + of + true -> t_boolean(); + false -> t_atom(false) + end + end. + +%%----------------------------------------------------------------------------- %% Tuples %% @@ -1386,6 +1958,8 @@ t_tuple() -> -spec t_tuple(non_neg_integer() | [erl_type()]) -> erl_type(). +t_tuple(N) when is_integer(N), N > ?MAX_TUPLE_SIZE -> + t_tuple(); t_tuple(N) when is_integer(N) -> ?tuple(lists:duplicate(N, ?any), N, ?any); t_tuple(List) -> @@ -1404,32 +1978,77 @@ t_tuple(List) -> -spec get_tuple_tags([erl_type()]) -> [erl_type(),...]. -get_tuple_tags([?atom(?any)|_]) -> [?any]; -get_tuple_tags([?atom(Set)|_]) -> +get_tuple_tags([Tag|_]) -> + do_opaque(Tag, 'universe', fun tuple_tags/1); +get_tuple_tags(_) -> [?any]. + +tuple_tags(?atom(?any)) -> [?any]; +tuple_tags(?atom(Set)) -> case set_size(Set) > ?TUPLE_TAG_LIMIT of true -> [?any]; false -> [t_atom(A) || A <- set_to_list(Set)] end; -get_tuple_tags(_) -> [?any]. +tuple_tags(_) -> [?any]. %% to be used for a tuple with known types for its arguments (not ?any) -spec t_tuple_args(erl_type()) -> [erl_type()]. -t_tuple_args(?tuple(Args, _, _)) when is_list(Args) -> Args. +t_tuple_args(Type) -> + t_tuple_args(Type, 'universe'). + +%% to be used for a tuple with known types for its arguments (not ?any) +-spec t_tuple_args(erl_type(), opaques()) -> [erl_type()]. + +t_tuple_args(Type, Opaques) -> + do_opaque(Type, Opaques, fun tuple_args/1). + +tuple_args(?tuple(Args, _, _)) when is_list(Args) -> Args. %% to be used for a tuple with a known size (not ?any) -spec t_tuple_size(erl_type()) -> non_neg_integer(). -t_tuple_size(?tuple(_, Size, _)) when is_integer(Size) -> Size. +t_tuple_size(Type) -> + t_tuple_size(Type, 'universe'). + +%% to be used for a tuple with a known size (not ?any) +-spec t_tuple_size(erl_type(), opaques()) -> non_neg_integer(). + +t_tuple_size(Type, Opaques) -> + do_opaque(Type, Opaques, fun tuple_size1/1). + +tuple_size1(?tuple(_, Size, _)) when is_integer(Size) -> Size. -spec t_tuple_sizes(erl_type()) -> 'unknown' | [non_neg_integer(),...]. -t_tuple_sizes(?tuple(?any, ?any, ?any)) -> unknown; -t_tuple_sizes(?tuple(_, Size, _)) when is_integer(Size) -> [Size]; -t_tuple_sizes(?tuple_set(List)) -> [Size || {Size, _} <- List]. +t_tuple_sizes(Type) -> + do_opaque(Type, 'universe', fun tuple_sizes/1). + +tuple_sizes(?tuple(?any, ?any, ?any)) -> unknown; +tuple_sizes(?tuple(_, Size, _)) when is_integer(Size) -> [Size]; +tuple_sizes(?tuple_set(List)) -> [Size || {Size, _} <- List]. + +-spec t_tuple_subtypes(erl_type(), opaques()) -> + 'unknown' | [erl_type(),...]. + +t_tuple_subtypes(Type, Opaques) -> + Fun = fun(?tuple_set(List)) -> + t_tuple_subtypes_tuple_list(List, Opaques); + (?opaque(_)) -> unknown; + (T) -> t_tuple_subtypes(T) + end, + do_opaque(Type, Opaques, Fun). + +t_tuple_subtypes_tuple_list(List, Opaques) -> + lists:append([t_tuple_subtypes_list(Tuples, Opaques) || + {_Size, Tuples} <- List]). + +t_tuple_subtypes_list(List, Opaques) -> + ListOfLists = [t_tuple_subtypes(E, Opaques) || E <- List, E =/= ?none], + lists:append([L || L <- ListOfLists, L =/= 'unknown']). -spec t_tuple_subtypes(erl_type()) -> 'unknown' | [erl_type(),...]. +%% XXX. Not the same as t_tuple_subtypes(T, 'universe')... t_tuple_subtypes(?tuple(?any, ?any, ?any)) -> unknown; t_tuple_subtypes(?tuple(_, _, _) = T) -> [T]; t_tuple_subtypes(?tuple_set(List)) -> @@ -1437,9 +2056,17 @@ t_tuple_subtypes(?tuple_set(List)) -> -spec t_is_tuple(erl_type()) -> boolean(). -t_is_tuple(?tuple(_, _, _)) -> true; -t_is_tuple(?tuple_set(_)) -> true; -t_is_tuple(_) -> false. +t_is_tuple(Type) -> + t_is_tuple(Type, 'universe'). + +-spec t_is_tuple(erl_type(), opaques()) -> boolean(). + +t_is_tuple(Type, Opaques) -> + do_opaque(Type, Opaques, fun is_tuple1/1). + +is_tuple1(?tuple(_, _, _)) -> true; +is_tuple1(?tuple_set(_)) -> true; +is_tuple1(_) -> false. %%----------------------------------------------------------------------------- %% Non-primitive types, including some handy syntactic sugar types @@ -1450,16 +2077,6 @@ t_is_tuple(_) -> false. t_bitstrlist() -> t_iolist(1, t_bitstr()). --spec t_constant() -> erl_type(). - -t_constant() -> - t_sup([t_number(), t_identifier(), t_atom(), t_fun(), t_binary()]). - --spec t_is_constant(erl_type()) -> boolean(). - -t_is_constant(X) -> - t_is_subtype(X, t_constant()). - -spec t_arity() -> erl_type(). t_arity() -> @@ -1509,7 +2126,7 @@ t_mfa() -> -spec t_module() -> erl_type(). t_module() -> - t_sup(t_atom(), t_parameterized_module()). + t_atom(). -spec t_node() -> erl_type(). @@ -1535,96 +2152,11 @@ t_iolist(N, T) when N > 0 -> t_iolist(0, T) -> t_maybe_improper_list(t_any(), t_sup(T, t_nil())). --spec t_parameterized_module() -> erl_type(). - -t_parameterized_module() -> - t_tuple(). - -spec t_timeout() -> erl_type(). t_timeout() -> t_sup(t_non_neg_integer(), t_atom('infinity')). -%%----------------------------------------------------------------------------- -%% Some built-in opaque types -%% - --spec t_array() -> erl_type(). - -t_array() -> - t_opaque(array, array, [], - t_tuple([t_atom('array'), - t_non_neg_integer(), t_non_neg_integer(), - t_any(), t_any()])). - --spec t_dict() -> erl_type(). - -t_dict() -> - t_opaque(dict, dict, [], - t_tuple([t_atom('dict'), - t_non_neg_integer(), t_non_neg_integer(), - t_non_neg_integer(), t_non_neg_integer(), - t_non_neg_integer(), t_non_neg_integer(), - t_tuple(), t_tuple()])). - --spec t_digraph() -> erl_type(). - -t_digraph() -> - t_opaque(digraph, digraph, [], - t_tuple([t_atom('digraph'), - t_sup(t_atom(), t_tid()), - t_sup(t_atom(), t_tid()), - t_sup(t_atom(), t_tid()), - t_boolean()])). - --spec t_gb_set() -> erl_type(). - -t_gb_set() -> - t_opaque(gb_sets, gb_set, [], - t_tuple([t_non_neg_integer(), t_sup(t_atom('nil'), t_tuple(3))])). - --spec t_gb_tree() -> erl_type(). - -t_gb_tree() -> - t_opaque(gb_trees, gb_tree, [], - t_tuple([t_non_neg_integer(), t_sup(t_atom('nil'), t_tuple(4))])). - --spec t_queue() -> erl_type(). - -t_queue() -> - t_opaque(queue, queue, [], t_tuple([t_list(), t_list()])). - --spec t_set() -> erl_type(). - -t_set() -> - t_opaque(sets, set, [], - t_tuple([t_atom('set'), t_non_neg_integer(), t_non_neg_integer(), - t_pos_integer(), t_non_neg_integer(), t_non_neg_integer(), - t_non_neg_integer(), t_tuple(), t_tuple()])). - --spec t_tid() -> erl_type(). - -t_tid() -> - t_opaque(ets, tid, [], t_integer()). - --spec all_opaque_builtins() -> [erl_type(),...]. - -all_opaque_builtins() -> - [t_array(), t_dict(), t_digraph(), t_gb_set(), - t_gb_tree(), t_queue(), t_set(), t_tid()]. - --spec is_opaque_builtin(atom(), atom()) -> boolean(). - -is_opaque_builtin(array, array) -> true; -is_opaque_builtin(dict, dict) -> true; -is_opaque_builtin(digraph, digraph) -> true; -is_opaque_builtin(gb_sets, gb_set) -> true; -is_opaque_builtin(gb_trees, gb_tree) -> true; -is_opaque_builtin(queue, queue) -> true; -is_opaque_builtin(sets, set) -> true; -is_opaque_builtin(ets, tid) -> true; -is_opaque_builtin(_, _) -> false. - %%------------------------------------ %% ?none is allowed in products. A product of size 1 is not a product. @@ -1672,8 +2204,14 @@ t_has_var(?tuple(Elements, _, _)) -> t_has_var_list(Elements); t_has_var(?tuple_set(_) = T) -> t_has_var_list(t_tuple_subtypes(T)); -%% t_has_var(?union(_) = U) -> -%% exit(lists:flatten(io_lib:format("Union happens in t_has_var/1 ~p\n",[U]))); +t_has_var(?map(_, DefK, _)= Map) -> + t_has_var_list(map_all_values(Map)) orelse + t_has_var(DefK); +t_has_var(?opaque(Set)) -> + %% Assume variables in 'args' are also present i 'struct' + t_has_var_list([O#opaque.struct || O <- set_to_list(Set)]); +t_has_var(?union(List)) -> + t_has_var_list(List); t_has_var(_) -> false. -spec t_has_var_list([erl_type()]) -> boolean(). @@ -1696,17 +2234,28 @@ t_collect_vars(?function(Domain, Range), Acc) -> t_collect_vars(?list(Contents, Termination, _), Acc) -> ordsets:union(t_collect_vars(Contents, Acc), t_collect_vars(Termination, [])); t_collect_vars(?product(Types), Acc) -> - lists:foldl(fun(T, TmpAcc) -> t_collect_vars(T, TmpAcc) end, Acc, Types); + t_collect_vars_list(Types, Acc); t_collect_vars(?tuple(?any, ?any, ?any), Acc) -> Acc; t_collect_vars(?tuple(Types, _, _), Acc) -> - lists:foldl(fun(T, TmpAcc) -> t_collect_vars(T, TmpAcc) end, Acc, Types); + t_collect_vars_list(Types, Acc); t_collect_vars(?tuple_set(_) = TS, Acc) -> - lists:foldl(fun(T, TmpAcc) -> t_collect_vars(T, TmpAcc) end, Acc, - t_tuple_subtypes(TS)); + t_collect_vars_list(t_tuple_subtypes(TS), Acc); +t_collect_vars(?map(_, DefK, _) = Map, Acc0) -> + Acc = t_collect_vars_list(map_all_values(Map), Acc0), + t_collect_vars(DefK, Acc); +t_collect_vars(?opaque(Set), Acc) -> + %% Assume variables in 'args' are also present i 'struct' + t_collect_vars_list([O#opaque.struct || O <- set_to_list(Set)], Acc); +t_collect_vars(?union(List), Acc) -> + t_collect_vars_list(List, Acc); t_collect_vars(_, Acc) -> Acc. +t_collect_vars_list([T|Ts], Acc0) -> + Acc = t_collect_vars(T, Acc0), + t_collect_vars_list(Ts, Acc); +t_collect_vars_list([], Acc) -> Acc. %%============================================================================= %% @@ -1729,6 +2278,15 @@ t_from_term(T) when is_function(T) -> {arity, Arity} = erlang:fun_info(T, arity), t_fun(Arity, t_any()); t_from_term(T) when is_integer(T) -> t_integer(T); +t_from_term(T) when is_map(T) -> + Pairs = [{t_from_term(K), ?mand, t_from_term(V)} + || {K, V} <- maps:to_list(T)], + {Stons, Rest} = lists:partition(fun({K,_,_}) -> is_singleton_type(K) end, + Pairs), + {DefK, DefV} + = lists:foldl(fun({K,_,V},{AK,AV}) -> {t_sup(K,AK), t_sup(V,AV)} end, + {t_none(), t_none()}, Rest), + t_map(lists:keysort(1, Stons), DefK, DefV); t_from_term(T) when is_pid(T) -> t_pid(); t_from_term(T) when is_port(T) -> t_port(); t_from_term(T) when is_reference(T) -> t_reference(); @@ -1826,15 +2384,31 @@ t_is_bitwidth(_) -> false. -spec number_min(erl_type()) -> rng_elem(). -number_min(?int_range(From, _)) -> From; -number_min(?int_set(Set)) -> set_min(Set); -number_min(?number(?any, _Tag)) -> neg_inf. +number_min(Type) -> + number_min(Type, 'universe'). + +-spec number_min(erl_type(), opaques()) -> rng_elem(). + +number_min(Type, Opaques) -> + do_opaque(Type, Opaques, fun number_min2/1). + +number_min2(?int_range(From, _)) -> From; +number_min2(?int_set(Set)) -> set_min(Set); +number_min2(?number(?any, _Tag)) -> neg_inf. -spec number_max(erl_type()) -> rng_elem(). -number_max(?int_range(_, To)) -> To; -number_max(?int_set(Set)) -> set_max(Set); -number_max(?number(?any, _Tag)) -> pos_inf. +number_max(Type) -> + number_max(Type, 'universe'). + +-spec number_max(erl_type(), opaques()) -> rng_elem(). + +number_max(Type, Opaques) -> + do_opaque(Type, Opaques, fun number_max2/1). + +number_max2(?int_range(_, To)) -> To; +number_max2(?int_set(Set)) -> set_max(Set); +number_max2(?number(?any, _Tag)) -> pos_inf. %% -spec int_range(rgn_elem(), rng_elem()) -> erl_type(). %% @@ -1886,14 +2460,19 @@ expand_range_from_set(Range = ?int_range(From, To), Set) -> -spec t_sup([erl_type()]) -> erl_type(). -t_sup([?any|_]) -> - ?any; -t_sup([H1, H2|T]) -> - t_sup([t_sup(H1, H2)|T]); -t_sup([H]) -> - subst_all_vars_to_any(H); -t_sup([]) -> - ?none. +t_sup([]) -> ?none; +t_sup(Ts) -> + case lists:any(fun is_any/1, Ts) of + true -> ?any; + false -> + t_sup1(Ts, []) + end. + +t_sup1([H1, H2|T], L) -> + t_sup1(T, [t_sup(H1, H2)|L]); +t_sup1([T], []) -> subst_all_vars_to_any(T); +t_sup1(Ts, L) -> + t_sup1(Ts++L, []). -spec t_sup(erl_type(), erl_type()) -> erl_type(). @@ -1916,14 +2495,12 @@ t_sup(?function(Domain1, Range1), ?function(Domain2, Range2)) -> t_sup(?identifier(Set1), ?identifier(Set2)) -> ?identifier(set_union(Set1, Set2)); t_sup(?opaque(Set1), ?opaque(Set2)) -> - ?opaque(set_union_no_limit(Set1, Set2)); + sup_opaque(set_to_list(ordsets:union(Set1, Set2))); %%Disallow unions with opaque types %%t_sup(T1=?opaque(_,_,_), T2) -> %% io:format("Debug: t_sup executed with args ~w and ~w~n",[T1, T2]), ?none; %%t_sup(T1, T2=?opaque(_,_,_)) -> %% io:format("Debug: t_sup executed with args ~w and ~w~n",[T1, T2]), ?none; -t_sup(?remote(Set1), ?remote(Set2)) -> - ?remote(set_union_no_limit(Set1, Set2)); t_sup(?matchstate(Pres1, Slots1), ?matchstate(Pres2, Slots2)) -> ?matchstate(t_sup(Pres1, Pres2), t_sup(Slots1, Slots2)); t_sup(?nil, ?nil) -> ?nil; @@ -1999,11 +2576,39 @@ t_sup(?tuple_set(List1), T2 = ?tuple(_, Arity, _)) -> sup_tuple_sets(List1, [{Arity, [T2]}]); t_sup(?tuple(_, Arity, _) = T1, ?tuple_set(List2)) -> sup_tuple_sets([{Arity, [T1]}], List2); +t_sup(?map(_, ADefK, ADefV) = A, ?map(_, BDefK, BDefV) = B) -> + Pairs = + map_pairwise_merge( + fun(K, MNess, V1, MNess, V2) -> {K, MNess, t_sup(V1, V2)}; + (K, _, V1, _, V2) -> {K, ?opt, t_sup(V1, V2)} + end, A, B), + t_map(Pairs, t_sup(ADefK, BDefK), t_sup(ADefV, BDefV)); t_sup(T1, T2) -> ?union(U1) = force_union(T1), ?union(U2) = force_union(T2), sup_union(U1, U2). +sup_opaque([]) -> ?none; +sup_opaque(List) -> + L = sup_opaq(List), + ?opaque(ordsets:from_list(L)). + +sup_opaq(L0) -> + L1 = [{{Mod,Name,Args}, T} || + #opaque{mod = Mod, name = Name, args = Args}=T <- L0], + F = family(L1), + [supl(Ts) || {_, Ts} <- F]. + +supl([O]) -> O; +supl(Ts) -> supl(Ts, t_none()). + +supl([#opaque{struct = S}=O|L], S0) -> + S1 = t_sup(S, S0), + case L =:= [] of + true -> O#opaque{struct = S1}; + false -> supl(L, S1) + end. + -spec t_sup_lists([erl_type()], [erl_type()]) -> [erl_type()]. t_sup_lists([T1|Left1], [T2|Left2]) -> @@ -2094,9 +2699,9 @@ force_union(T = ?function(_, _)) -> ?function_union(T); force_union(T = ?identifier(_)) -> ?identifier_union(T); force_union(T = ?list(_, _, _)) -> ?list_union(T); force_union(T = ?nil) -> ?list_union(T); -force_union(T = ?number(_,_)) -> ?number_union(T); +force_union(T = ?number(_, _)) -> ?number_union(T); force_union(T = ?opaque(_)) -> ?opaque_union(T); -force_union(T = ?remote(_)) -> ?remote_union(T); +force_union(T = ?map(_,_,_)) -> ?map_union(T); force_union(T = ?tuple(_, _, _)) -> ?tuple_union(T); force_union(T = ?tuple_set(_)) -> ?tuple_union(T); force_union(T = ?matchstate(_, _)) -> ?matchstate_union(T); @@ -2131,19 +2736,27 @@ t_elements(?number(_, _) = T) -> ?int_set(Set) -> [t_integer(I) || I <- Set] end; -t_elements(?opaque(_) = T) -> [T]; +t_elements(?opaque(_) = T) -> + do_elements(T); +t_elements(?map(_,_,_) = T) -> [T]; t_elements(?tuple(_, _, _) = T) -> [T]; t_elements(?tuple_set(_) = TS) -> case t_tuple_subtypes(TS) of unknown -> []; Elems -> Elems end; -t_elements(?union(List)) -> - lists:append([t_elements(T) || T <- List]); +t_elements(?union(_) = T) -> + do_elements(T); t_elements(?var(_)) -> [?any]. %% yes, vars exist -- what else to do here? %% t_elements(T) -> %% io:format("T_ELEMENTS => ~p\n", [T]). +do_elements(Type0) -> + case do_opaque(Type0, 'universe', fun(T) -> T end) of + ?union(List) -> lists:append([t_elements(T) || T <- List]); + Type -> t_elements(Type) + end. + %%----------------------------------------------------------------------------- %% Infimum %% @@ -2161,74 +2774,95 @@ t_inf([]) -> ?none. -spec t_inf(erl_type(), erl_type()) -> erl_type(). t_inf(T1, T2) -> - t_inf(T1, T2, structured). - --type t_inf_mode() :: 'opaque' | 'structured'. --spec t_inf(erl_type(), erl_type(), t_inf_mode()) -> erl_type(). - -t_inf(?var(_), ?var(_), _Mode) -> ?any; -t_inf(?var(_), T, _Mode) -> subst_all_vars_to_any(T); -t_inf(T, ?var(_), _Mode) -> subst_all_vars_to_any(T); -t_inf(?any, T, _Mode) -> subst_all_vars_to_any(T); -t_inf(T, ?any, _Mode) -> subst_all_vars_to_any(T); -t_inf(?none, _, _Mode) -> ?none; -t_inf(_, ?none, _Mode) -> ?none; -t_inf(?unit, _, _Mode) -> ?unit; % ?unit cases should appear below ?none -t_inf(_, ?unit, _Mode) -> ?unit; -t_inf(T, T, _Mode) -> subst_all_vars_to_any(T); + t_inf(T1, T2, 'universe'). + +%% 'match' should be used from t_find_unknown_opaque() only +-type t_inf_opaques() :: opaques() | {'match', [erl_type() | 'universe']}. + +-spec t_inf(erl_type(), erl_type(), t_inf_opaques()) -> erl_type(). + +t_inf(?var(_), ?var(_), _Opaques) -> ?any; +t_inf(?var(_), T, _Opaques) -> subst_all_vars_to_any(T); +t_inf(T, ?var(_), _Opaques) -> subst_all_vars_to_any(T); +t_inf(?any, T, _Opaques) -> subst_all_vars_to_any(T); +t_inf(T, ?any, _Opaques) -> subst_all_vars_to_any(T); +t_inf(?none, _, _Opaques) -> ?none; +t_inf(_, ?none, _Opaques) -> ?none; +t_inf(?unit, _, _Opaques) -> ?unit; % ?unit cases should appear below ?none +t_inf(_, ?unit, _Opaques) -> ?unit; +t_inf(T, T, _Opaques) -> subst_all_vars_to_any(T); t_inf(?atom(Set1), ?atom(Set2), _) -> case set_intersection(Set1, Set2) of ?none -> ?none; NewSet -> ?atom(NewSet) end; -t_inf(?bitstr(U1, B1), ?bitstr(0, B2), _Mode) -> +t_inf(?bitstr(U1, B1), ?bitstr(0, B2), _Opaques) -> if B2 >= B1 andalso (B2-B1) rem U1 =:= 0 -> t_bitstr(0, B2); true -> ?none end; -t_inf(?bitstr(0, B1), ?bitstr(U2, B2), _Mode) -> +t_inf(?bitstr(0, B1), ?bitstr(U2, B2), _Opaques) -> if B1 >= B2 andalso (B1-B2) rem U2 =:= 0 -> t_bitstr(0, B1); true -> ?none end; -t_inf(?bitstr(U1, B1), ?bitstr(U1, B1), _Mode) -> +t_inf(?bitstr(U1, B1), ?bitstr(U1, B1), _Opaques) -> t_bitstr(U1, B1); -t_inf(?bitstr(U1, B1), ?bitstr(U2, B2), _Mode) when U2 > U1 -> +t_inf(?bitstr(U1, B1), ?bitstr(U2, B2), _Opaques) when U2 > U1 -> inf_bitstr(U2, B2, U1, B1); -t_inf(?bitstr(U1, B1), ?bitstr(U2, B2), _Mode) -> +t_inf(?bitstr(U1, B1), ?bitstr(U2, B2), _Opaques) -> inf_bitstr(U1, B1, U2, B2); -t_inf(?function(Domain1, Range1), ?function(Domain2, Range2), Mode) -> - case t_inf(Domain1, Domain2, Mode) of +t_inf(?function(Domain1, Range1), ?function(Domain2, Range2), Opaques) -> + case t_inf(Domain1, Domain2, Opaques) of ?none -> ?none; - Domain -> ?function(Domain, t_inf(Range1, Range2, Mode)) + Domain -> ?function(Domain, t_inf(Range1, Range2, Opaques)) end; -t_inf(?identifier(Set1), ?identifier(Set2), _Mode) -> +t_inf(?identifier(Set1), ?identifier(Set2), _Opaques) -> case set_intersection(Set1, Set2) of ?none -> ?none; Set -> ?identifier(Set) end; -t_inf(?matchstate(Pres1, Slots1), ?matchstate(Pres2, Slots2), _Mode) -> +t_inf(?map(_, ADefK, ADefV) = A, ?map(_, BDefK, BDefV) = B, _Opaques) -> + %% Because it simplifies the anonymous function, we allow Pairs to temporarily + %% contain mandatory pairs with none values, since all such cases should + %% result in a none result. + Pairs = + map_pairwise_merge( + %% For optional keys in both maps, when the infinimum is none, we have + %% essentially concluded that K must not be a key in the map. + fun(K, ?opt, V1, ?opt, V2) -> {K, ?opt, t_inf(V1, V2)}; + %% When a key is optional in one map, but mandatory in another, it + %% becomes mandatory in the infinumum + (K, _, V1, _, V2) -> {K, ?mand, t_inf(V1, V2)} + end, A, B), + %% If the infinimum of any mandatory values is ?none, the entire map infinimum + %% is ?none. + case lists:any(fun({_,?mand,?none})->true; ({_,_,_}) -> false end, Pairs) of + true -> t_none(); + false -> t_map(Pairs, t_inf(ADefK, BDefK), t_inf(ADefV, BDefV)) + end; +t_inf(?matchstate(Pres1, Slots1), ?matchstate(Pres2, Slots2), _Opaques) -> ?matchstate(t_inf(Pres1, Pres2), t_inf(Slots1, Slots2)); -t_inf(?nil, ?nil, _Mode) -> ?nil; -t_inf(?nil, ?nonempty_list(_, _), _Mode) -> +t_inf(?nil, ?nil, _Opaques) -> ?nil; +t_inf(?nil, ?nonempty_list(_, _), _Opaques) -> ?none; -t_inf(?nonempty_list(_, _), ?nil, _Mode) -> +t_inf(?nonempty_list(_, _), ?nil, _Opaques) -> ?none; -t_inf(?nil, ?list(_Contents, Termination, _), Mode) -> - t_inf(?nil, Termination, Mode); -t_inf(?list(_Contents, Termination, _), ?nil, Mode) -> - t_inf(?nil, Termination, Mode); +t_inf(?nil, ?list(_Contents, Termination, _), Opaques) -> + t_inf(?nil, t_unopaque(Termination), Opaques); +t_inf(?list(_Contents, Termination, _), ?nil, Opaques) -> + t_inf(?nil, t_unopaque(Termination), Opaques); t_inf(?list(Contents1, Termination1, Size1), - ?list(Contents2, Termination2, Size2), Mode) -> - case t_inf(Termination1, Termination2, Mode) of + ?list(Contents2, Termination2, Size2), Opaques) -> + case t_inf(Termination1, Termination2, Opaques) of ?none -> ?none; Termination -> - case t_inf(Contents1, Contents2, Mode) of - ?none -> + case t_inf(Contents1, Contents2, Opaques) of + ?none -> %% If none of the lists are nonempty, then the infimum is nil. case (Size1 =:= ?unknown_qual) andalso (Size2 =:= ?unknown_qual) of true -> t_nil(); false -> ?none end; - Contents -> + Contents -> Size = case {Size1, Size2} of {?unknown_qual, ?unknown_qual} -> ?unknown_qual; @@ -2239,7 +2873,7 @@ t_inf(?list(Contents1, Termination1, Size1), ?list(Contents, Termination, Size) end end; -t_inf(?number(_, _) = T1, ?number(_, _) = T2, _Mode) -> +t_inf(?number(_, _) = T1, ?number(_, _) = T2, _Opaques) -> case {T1, T2} of {T, T} -> T; {_, ?number(?any, ?unknown_qual)} -> T1; @@ -2248,16 +2882,16 @@ t_inf(?number(_, _) = T1, ?number(_, _) = T2, _Mode) -> {?integer(_), ?float} -> ?none; {?integer(?any), ?integer(_)} -> T2; {?integer(_), ?integer(?any)} -> T1; - {?int_set(Set1), ?int_set(Set2)} -> + {?int_set(Set1), ?int_set(Set2)} -> case set_intersection(Set1, Set2) of ?none -> ?none; Set -> ?int_set(Set) end; - {?int_range(From1, To1), ?int_range(From2, To2)} -> + {?int_range(From1, To1), ?int_range(From2, To2)} -> t_from_range(max(From1, From2), min(To1, To2)); {Range = ?int_range(_, _), ?int_set(Set)} -> %% io:format("t_inf range, set args ~p ~p ~n", [T1, T2]), - Ans2 = + Ans2 = case set_filter(fun(X) -> in_range(X, Range) end, Set) of ?none -> ?none; NewSet -> ?int_set(NewSet) @@ -2270,198 +2904,376 @@ t_inf(?number(_, _) = T1, ?number(_, _) = T2, _Mode) -> NewSet -> ?int_set(NewSet) end end; -t_inf(?product(Types1), ?product(Types2), Mode) -> +t_inf(?product(Types1), ?product(Types2), Opaques) -> L1 = length(Types1), L2 = length(Types2), - if L1 =:= L2 -> ?product(t_inf_lists(Types1, Types2, Mode)); + if L1 =:= L2 -> ?product(t_inf_lists(Types1, Types2, Opaques)); true -> ?none end; -t_inf(?product(_), _, _Mode) -> +t_inf(?product(_), _, _Opaques) -> ?none; -t_inf(_, ?product(_), _Mode) -> +t_inf(_, ?product(_), _Opaques) -> ?none; -t_inf(?tuple(?any, ?any, ?any), ?tuple(_, _, _) = T, _Mode) -> +t_inf(?tuple(?any, ?any, ?any), ?tuple(_, _, _) = T, _Opaques) -> subst_all_vars_to_any(T); -t_inf(?tuple(_, _, _) = T, ?tuple(?any, ?any, ?any), _Mode) -> +t_inf(?tuple(_, _, _) = T, ?tuple(?any, ?any, ?any), _Opaques) -> subst_all_vars_to_any(T); -t_inf(?tuple(?any, ?any, ?any), ?tuple_set(_) = T, _Mode) -> +t_inf(?tuple(?any, ?any, ?any), ?tuple_set(_) = T, _Opaques) -> subst_all_vars_to_any(T); -t_inf(?tuple_set(_) = T, ?tuple(?any, ?any, ?any), _Mode) -> +t_inf(?tuple_set(_) = T, ?tuple(?any, ?any, ?any), _Opaques) -> subst_all_vars_to_any(T); -t_inf(?tuple(Elements1, Arity, _Tag1), ?tuple(Elements2, Arity, _Tag2), Mode) -> - case t_inf_lists_strict(Elements1, Elements2, Mode) of +t_inf(?tuple(Elements1, Arity, _Tag1), ?tuple(Elements2, Arity, _Tag2), Opaques) -> + case t_inf_lists_strict(Elements1, Elements2, Opaques) of bottom -> ?none; NewElements -> t_tuple(NewElements) end; -t_inf(?tuple_set(List1), ?tuple_set(List2), Mode) -> - inf_tuple_sets(List1, List2, Mode); -t_inf(?tuple_set(List), ?tuple(_, Arity, _) = T, Mode) -> - inf_tuple_sets(List, [{Arity, [T]}], Mode); -t_inf(?tuple(_, Arity, _) = T, ?tuple_set(List), Mode) -> - inf_tuple_sets(List, [{Arity, [T]}], Mode); +t_inf(?tuple_set(List1), ?tuple_set(List2), Opaques) -> + inf_tuple_sets(List1, List2, Opaques); +t_inf(?tuple_set(List), ?tuple(_, Arity, _) = T, Opaques) -> + inf_tuple_sets(List, [{Arity, [T]}], Opaques); +t_inf(?tuple(_, Arity, _) = T, ?tuple_set(List), Opaques) -> + inf_tuple_sets(List, [{Arity, [T]}], Opaques); %% be careful: here and in the next clause T can be ?opaque -t_inf(?union(U1), T, Mode) -> +t_inf(?union(U1), T, Opaques) -> ?union(U2) = force_union(T), - inf_union(U1, U2, Mode); -t_inf(T, ?union(U2), Mode) -> + inf_union(U1, U2, Opaques); +t_inf(T, ?union(U2), Opaques) -> ?union(U1) = force_union(T), - inf_union(U1, U2, Mode); + inf_union(U1, U2, Opaques); +t_inf(?opaque(Set1), ?opaque(Set2), Opaques) -> + inf_opaque(Set1, Set2, Opaques); +t_inf(?opaque(_) = T1, T2, Opaques) -> + inf_opaque1(T2, T1, 1, Opaques); +t_inf(T1, ?opaque(_) = T2, Opaques) -> + inf_opaque1(T1, T2, 2, Opaques); %% and as a result, the cases for ?opaque should appear *after* ?union -t_inf(?opaque(Set1) = T1, ?opaque(Set2) = T2, Mode) -> - case set_intersection(Set1, Set2) of - ?none -> - case Mode =:= opaque of - true -> - Struct1 = t_opaque_structure(T1), - case t_inf(Struct1, T2) of - ?none -> - Struct2 = t_opaque_structure(T2), - case t_inf(Struct2, T1) of - ?none -> ?none; - _ -> T2 - end; - _ -> T1 - end; - false -> ?none - end; - NewSet -> ?opaque(NewSet) +t_inf(#c{}, #c{}, _) -> + ?none. + +inf_opaque1(T1, ?opaque(Set2)=T2, Pos, Opaques) -> + case Opaques =:= 'universe' orelse inf_is_opaque_type(T2, Pos, Opaques) of + false -> ?none; + true -> + List2 = set_to_list(Set2), + case inf_collect(T1, List2, Opaques, []) of + [] -> ?none; + OpL -> ?opaque(ordsets:from_list(OpL)) + end + end. + +inf_is_opaque_type(T, Pos, {match, Opaques}) -> + is_opaque_type(T, Opaques) orelse throw({pos, [Pos]}); +inf_is_opaque_type(T, _Pos, Opaques) -> + is_opaque_type(T, Opaques). + +inf_collect(T1, [T2|List2], Opaques, OpL) -> + #opaque{struct = S2} = T2, + case t_inf(T1, S2, Opaques) of + ?none -> inf_collect(T1, List2, Opaques, OpL); + Inf -> + Op = T2#opaque{struct = Inf}, + inf_collect(T1, List2, Opaques, [Op|OpL]) end; -t_inf(?opaque(_) = T1, T2, opaque) -> - case t_inf(t_opaque_structure(T1), T2, structured) of - ?none -> ?none; - _Type -> T1 +inf_collect(_T1, [], _Opaques, OpL) -> + OpL. + +combine(S, T1, T2) -> + #opaque{mod = Mod1, name = Name1, args = Args1} = T1, + #opaque{mod = Mod2, name = Name2, args = Args2} = T2, + Comb1 = comb(Mod1, Name1, Args1, S, T1), + case is_compat_opaque_names({Mod1, Name1, Args1}, {Mod2, Name2, Args2}) of + true -> Comb1; + false -> Comb1 ++ comb(Mod2, Name2, Args2, S, T2) + end. + +comb(Mod, Name, Args, S, T) -> + case can_combine_opaque_names(Mod, Name, Args, S) of + true -> + ?opaque(Set) = S, + Set; + false -> + [T#opaque{struct = S}] + end. + +can_combine_opaque_names(Mod1, Name1, Args1, + ?opaque([#opaque{mod = Mod2, name = Name2, args = Args2}])) -> + is_compat_opaque_names({Mod1, Name1, Args1}, {Mod2, Name2, Args2}); +can_combine_opaque_names(_, _, _, _) -> false. + +%% Combining two lists this way can be very time consuming... +%% Note: two parameterized opaque types are not the same if their +%% actual parameters differ +inf_opaque(Set1, Set2, Opaques) -> + List1 = inf_look_up(Set1, Opaques), + List2 = inf_look_up(Set2, Opaques), + List0 = [combine(Inf, T1, T2) || + {Is1, ModNameArgs1, T1} <- List1, + {Is2, ModNameArgs2, T2} <- List2, + not t_is_none(Inf = inf_opaque_types(Is1, ModNameArgs1, T1, + Is2, ModNameArgs2, T2, + Opaques))], + List = lists:sort(lists:append(List0)), + sup_opaque(List). + +%% Optimization: do just one lookup. +inf_look_up(Set, Opaques) -> + [{Opaques =:= 'universe' orelse inf_is_opaque_type2(T, Opaques), + {M, N, Args}, T} || + #opaque{mod = M, name = N, args = Args} = T <- set_to_list(Set)]. + +inf_is_opaque_type2(T, {match, Opaques}) -> + is_opaque_type2(T, Opaques); +inf_is_opaque_type2(T, Opaques) -> + is_opaque_type2(T, Opaques). + +inf_opaque_types(IsOpaque1, ModNameArgs1, T1, + IsOpaque2, ModNameArgs2, T2, Opaques) -> + #opaque{struct = S1}=T1, + #opaque{struct = S2}=T2, + case + Opaques =:= 'universe' orelse + is_compat_opaque_names(ModNameArgs1, ModNameArgs2) + of + true -> t_inf(S1, S2, Opaques); + false -> + case {IsOpaque1, IsOpaque2} of + {true, true} -> t_inf(S1, S2, Opaques); + {true, false} -> t_inf(S1, ?opaque(set_singleton(T2)), Opaques); + {false, true} -> t_inf(?opaque(set_singleton(T1)), S2, Opaques); + {false, false} when element(1, Opaques) =:= match -> + throw({pos, [1, 2]}); + {false, false} -> t_none() + end + end. + +is_compat_opaque_names(ModNameArgs, ModNameArgs) -> true; +is_compat_opaque_names({Mod,Name,Args1}, {Mod,Name,Args2}) -> + is_compat_args(Args1, Args2); +is_compat_opaque_names(_, _) -> false. + +is_compat_args([A1|Args1], [A2|Args2]) -> + is_compat_arg(A1, A2) andalso is_compat_args(Args1, Args2); +is_compat_args([], []) -> true; +is_compat_args(_, _) -> false. + +is_compat_arg(A1, A2) -> + is_specialization(A1, A2) orelse is_specialization(A2, A1). + +-spec is_specialization(erl_type(), erl_type()) -> boolean(). + +%% Returns true if the first argument is a specialization of the +%% second argument in the sense that every type is a specialization of +%% any(). For example, {_,_} is a specialization of any(), but not of +%% tuple(). Does not handle variables, but any() and unions (sort of). + +is_specialization(T, T) -> true; +is_specialization(_, ?any) -> true; +is_specialization(?any, _) -> false; +is_specialization(?function(Domain1, Range1), ?function(Domain2, Range2)) -> + (is_specialization(Domain1, Domain2) andalso + is_specialization(Range1, Range2)); +is_specialization(?list(Contents1, Termination1, Size1), + ?list(Contents2, Termination2, Size2)) -> + (Size1 =:= Size2 andalso + is_specialization(Contents1, Contents2) andalso + is_specialization(Termination1, Termination2)); +is_specialization(?product(Types1), ?product(Types2)) -> + specialization_list(Types1, Types2); +is_specialization(?tuple(?any, ?any, ?any), ?tuple(_, _, _)) -> false; +is_specialization(?tuple(_, _, _), ?tuple(?any, ?any, ?any)) -> false; +is_specialization(?tuple(Elements1, Arity, _), + ?tuple(Elements2, Arity, _)) when Arity =/= ?any -> + specialization_list(Elements1, Elements2); +is_specialization(?tuple_set([{Arity, List}]), + ?tuple(Elements2, Arity, _)) when Arity =/= ?any -> + specialization_list(sup_tuple_elements(List), Elements2); +is_specialization(?tuple(Elements1, Arity, _), + ?tuple_set([{Arity, List}])) when Arity =/= ?any -> + specialization_list(Elements1, sup_tuple_elements(List)); +is_specialization(?tuple_set(List1), ?tuple_set(List2)) -> + try + specialization_list_list([sup_tuple_elements(T) || {_Arity, T} <- List1], + [sup_tuple_elements(T) || {_Arity, T} <- List2]) + catch _:_ -> false end; -t_inf(T1, ?opaque(_) = T2, opaque) -> - case t_inf(T1, t_opaque_structure(T2), structured) of - ?none -> ?none; - _Type -> T2 +is_specialization(?union(List1)=T1, ?union(List2)=T2) -> + case specialization_union2(T1, T2) of + {yes, Type1, Type2} -> is_specialization(Type1, Type2); + no -> specialization_list(List1, List2) end; -t_inf(#c{}, #c{}, _) -> - ?none. +is_specialization(?union(List), T2) -> + case unify_union(List) of + {yes, Type} -> is_specialization(Type, T2); + no -> false + end; +is_specialization(T1, ?union(List)) -> + case unify_union(List) of + {yes, Type} -> is_specialization(T1, Type); + no -> false + end; +is_specialization(?opaque(_) = T1, T2) -> + is_specialization(t_opaque_structure(T1), T2); +is_specialization(T1, ?opaque(_) = T2) -> + is_specialization(T1, t_opaque_structure(T2)); +is_specialization(?var(_), _) -> exit(error); +is_specialization(_, ?var(_)) -> exit(error); +is_specialization(?none, _) -> false; +is_specialization(_, ?none) -> false; +is_specialization(?unit, _) -> false; +is_specialization(_, ?unit) -> false; +is_specialization(#c{}, #c{}) -> false. + +specialization_list_list(LL1, LL2) -> + length(LL1) =:= length(LL2) andalso specialization_list_list1(LL1, LL2). + +specialization_list_list1([], []) -> true; +specialization_list_list1([L1|LL1], [L2|LL2]) -> + specialization_list(L1, L2) andalso specialization_list_list1(LL1, LL2). + +specialization_list(L1, L2) -> + length(L1) =:= length(L2) andalso specialization_list1(L1, L2). + +specialization_list1([], []) -> true; +specialization_list1([T1|L1], [T2|L2]) -> + is_specialization(T1, T2) andalso specialization_list1(L1, L2). + +specialization_union2(?union(List1)=T1, ?union(List2)=T2) -> + case {unify_union(List1), unify_union(List2)} of + {{yes, Type1}, {yes, Type2}} -> {yes, Type1, Type2}; + {{yes, Type1}, no} -> {yes, Type1, T2}; + {no, {yes, Type2}} -> {yes, T1, Type2}; + {no, no} -> no + end. -spec t_inf_lists([erl_type()], [erl_type()]) -> [erl_type()]. t_inf_lists(L1, L2) -> - t_inf_lists(L1, L2, structured). + t_inf_lists(L1, L2, 'universe'). --spec t_inf_lists([erl_type()], [erl_type()], t_inf_mode()) -> [erl_type()]. +-spec t_inf_lists([erl_type()], [erl_type()], t_inf_opaques()) -> [erl_type()]. -t_inf_lists(L1, L2, Mode) -> - t_inf_lists(L1, L2, [], Mode). +t_inf_lists(L1, L2, Opaques) -> + t_inf_lists(L1, L2, [], Opaques). --spec t_inf_lists([erl_type()], [erl_type()], [erl_type()], t_inf_mode()) -> [erl_type()]. +-spec t_inf_lists([erl_type()], [erl_type()], [erl_type()], [erl_type()]) -> [erl_type()]. -t_inf_lists([T1|Left1], [T2|Left2], Acc, Mode) -> - t_inf_lists(Left1, Left2, [t_inf(T1, T2, Mode)|Acc], Mode); -t_inf_lists([], [], Acc, _Mode) -> +t_inf_lists([T1|Left1], [T2|Left2], Acc, Opaques) -> + t_inf_lists(Left1, Left2, [t_inf(T1, T2, Opaques)|Acc], Opaques); +t_inf_lists([], [], Acc, _Opaques) -> lists:reverse(Acc). %% Infimum of lists with strictness. %% If any element is the ?none type, the value 'bottom' is returned. --spec t_inf_lists_strict([erl_type()], [erl_type()], t_inf_mode()) -> 'bottom' | [erl_type()]. +-spec t_inf_lists_strict([erl_type()], [erl_type()], [erl_type()]) -> 'bottom' | [erl_type()]. -t_inf_lists_strict(L1, L2, Mode) -> - t_inf_lists_strict(L1, L2, [], Mode). +t_inf_lists_strict(L1, L2, Opaques) -> + t_inf_lists_strict(L1, L2, [], Opaques). --spec t_inf_lists_strict([erl_type()], [erl_type()], [erl_type()], t_inf_mode()) -> 'bottom' | [erl_type()]. +-spec t_inf_lists_strict([erl_type()], [erl_type()], [erl_type()], [erl_type()]) -> 'bottom' | [erl_type()]. -t_inf_lists_strict([T1|Left1], [T2|Left2], Acc, Mode) -> - case t_inf(T1, T2, Mode) of +t_inf_lists_strict([T1|Left1], [T2|Left2], Acc, Opaques) -> + case t_inf(T1, T2, Opaques) of ?none -> bottom; - T -> t_inf_lists_strict(Left1, Left2, [T|Acc], Mode) + T -> t_inf_lists_strict(Left1, Left2, [T|Acc], Opaques) end; -t_inf_lists_strict([], [], Acc, _Mode) -> +t_inf_lists_strict([], [], Acc, _Opaques) -> lists:reverse(Acc). --spec t_inf_lists_masked([erl_type()], [erl_type()], [t_inf_mode()]) -> [erl_type()]. - -t_inf_lists_masked(List1, List2, Mask) -> - List = lists:zip3(List1, List2, Mask), - [t_inf(T1, T2, Mode) || {T1, T2, Mode} <- List]. - -inf_tuple_sets(L1, L2, Mode) -> - case inf_tuple_sets(L1, L2, [], Mode) of +inf_tuple_sets(L1, L2, Opaques) -> + case inf_tuple_sets(L1, L2, [], Opaques) of [] -> ?none; [{_Arity, [?tuple(_, _, _) = OneTuple]}] -> OneTuple; List -> ?tuple_set(List) end. -inf_tuple_sets([{Arity, Tuples1}|Ts1], [{Arity, Tuples2}|Ts2], Acc, Mode) -> - case inf_tuples_in_sets(Tuples1, Tuples2, Mode) of - [] -> inf_tuple_sets(Ts1, Ts2, Acc, Mode); +inf_tuple_sets([{Arity, Tuples1}|Ts1], [{Arity, Tuples2}|Ts2], Acc, Opaques) -> + case inf_tuples_in_sets(Tuples1, Tuples2, Opaques) of + [] -> inf_tuple_sets(Ts1, Ts2, Acc, Opaques); [?tuple_set([{Arity, NewTuples}])] -> - inf_tuple_sets(Ts1, Ts2, [{Arity, NewTuples}|Acc], Mode); - NewTuples -> inf_tuple_sets(Ts1, Ts2, [{Arity, NewTuples}|Acc], Mode) + inf_tuple_sets(Ts1, Ts2, [{Arity, NewTuples}|Acc], Opaques); + NewTuples -> inf_tuple_sets(Ts1, Ts2, [{Arity, NewTuples}|Acc], Opaques) end; -inf_tuple_sets([{Arity1, _}|Ts1] = L1, [{Arity2, _}|Ts2] = L2, Acc, Mode) -> - if Arity1 < Arity2 -> inf_tuple_sets(Ts1, L2, Acc, Mode); - Arity1 > Arity2 -> inf_tuple_sets(L1, Ts2, Acc, Mode) +inf_tuple_sets([{Arity1, _}|Ts1] = L1, [{Arity2, _}|Ts2] = L2, Acc, Opaques) -> + if Arity1 < Arity2 -> inf_tuple_sets(Ts1, L2, Acc, Opaques); + Arity1 > Arity2 -> inf_tuple_sets(L1, Ts2, Acc, Opaques) end; -inf_tuple_sets([], _, Acc, _Mode) -> lists:reverse(Acc); -inf_tuple_sets(_, [], Acc, _Mode) -> lists:reverse(Acc). - -inf_tuples_in_sets([?tuple(Elements1, _, ?any)], L2, Mode) -> - NewList = [t_inf_lists_strict(Elements1, Elements2, Mode) +inf_tuple_sets([], _, Acc, _Opaques) -> lists:reverse(Acc); +inf_tuple_sets(_, [], Acc, _Opaques) -> lists:reverse(Acc). + +inf_tuples_in_sets([?tuple(Elements1, _, ?any)], L2, Opaques) -> + NewList = [t_inf_lists_strict(Elements1, Elements2, Opaques) || ?tuple(Elements2, _, _) <- L2], [t_tuple(Es) || Es <- NewList, Es =/= bottom]; -inf_tuples_in_sets(L1, [?tuple(Elements2, _, ?any)], Mode) -> - NewList = [t_inf_lists_strict(Elements1, Elements2, Mode) +inf_tuples_in_sets(L1, [?tuple(Elements2, _, ?any)], Opaques) -> + NewList = [t_inf_lists_strict(Elements1, Elements2, Opaques) || ?tuple(Elements1, _, _) <- L1], [t_tuple(Es) || Es <- NewList, Es =/= bottom]; -inf_tuples_in_sets(L1, L2, Mode) -> - inf_tuples_in_sets(L1, L2, [], Mode). +inf_tuples_in_sets(L1, L2, Opaques) -> + inf_tuples_in_sets2(L1, L2, [], Opaques). -inf_tuples_in_sets([?tuple(Elements1, Arity, Tag)|Ts1], - [?tuple(Elements2, Arity, Tag)|Ts2], Acc, Mode) -> - case t_inf_lists_strict(Elements1, Elements2, Mode) of - bottom -> inf_tuples_in_sets(Ts1, Ts2, Acc, Mode); +inf_tuples_in_sets2([?tuple(Elements1, Arity, Tag)|Ts1], + [?tuple(Elements2, Arity, Tag)|Ts2], Acc, Opaques) -> + case t_inf_lists_strict(Elements1, Elements2, Opaques) of + bottom -> inf_tuples_in_sets2(Ts1, Ts2, Acc, Opaques); NewElements -> - inf_tuples_in_sets(Ts1, Ts2, [?tuple(NewElements, Arity, Tag)|Acc], Mode) + inf_tuples_in_sets2(Ts1, Ts2, [?tuple(NewElements, Arity, Tag)|Acc], + Opaques) end; -inf_tuples_in_sets([?tuple(_, _, Tag1)|Ts1] = L1, - [?tuple(_, _, Tag2)|Ts2] = L2, Acc, Mode) -> - if Tag1 < Tag2 -> inf_tuples_in_sets(Ts1, L2, Acc, Mode); - Tag1 > Tag2 -> inf_tuples_in_sets(L1, Ts2, Acc, Mode) +inf_tuples_in_sets2([?tuple(_, _, Tag1)|Ts1] = L1, + [?tuple(_, _, Tag2)|Ts2] = L2, Acc, Opaques) -> + if Tag1 < Tag2 -> inf_tuples_in_sets2(Ts1, L2, Acc, Opaques); + Tag1 > Tag2 -> inf_tuples_in_sets2(L1, Ts2, Acc, Opaques) end; -inf_tuples_in_sets([], _, Acc, _Mode) -> lists:reverse(Acc); -inf_tuples_in_sets(_, [], Acc, _Mode) -> lists:reverse(Acc). - -inf_union(U1, U2, opaque) -> -%%--------------------------------------------------------------------- -%% Under Testing -%%---------------------------------------------------------------------- -%% OpaqueFun = -%% fun(Union1, Union2) -> -%% [_,_,_,_,_,_,_,_,Opaque,_] = Union1, -%% [A,B,F,I,L,N,T,M,_,_R] = Union2, -%% List = [A,B,F,I,L,N,T,M], -%% case [T || T <- List, t_inf(T, Opaque, opaque) =/= ?none] of -%% [] -> ?none; -%% _ -> Opaque -%% end -%% end, -%% O1 = OpaqueFun(U1, U2), -%% O2 = OpaqueFun(U2, U1), -%% Union = inf_union(U1, U2, 0, [], opaque), -%% t_sup([O1, O2, Union]); - inf_union(U1, U2, 0, [], opaque); -inf_union(U1, U2, OtherMode) -> - inf_union(U1, U2, 0, [], OtherMode). - -inf_union([?none|Left1], [?none|Left2], N, Acc, Mode) -> - inf_union(Left1, Left2, N, [?none|Acc], Mode); -inf_union([T1|Left1], [T2|Left2], N, Acc, Mode) -> - case t_inf(T1, T2, Mode) of - ?none -> inf_union(Left1, Left2, N, [?none|Acc], Mode); - T -> inf_union(Left1, Left2, N+1, [T|Acc], Mode) +inf_tuples_in_sets2([], _, Acc, _Opaques) -> lists:reverse(Acc); +inf_tuples_in_sets2(_, [], Acc, _Opaques) -> lists:reverse(Acc). + +inf_union(U1, U2, Opaques) -> + OpaqueFun = + fun(Union1, Union2, InfFun) -> + [_,_,_,_,_,_,_,_,Opaque,_] = Union1, + [A,B,F,I,L,N,T,M,_,Map] = Union2, + List = [A,B,F,I,L,N,T,M,Map], + inf_union_collect(List, Opaque, InfFun, [], []) + end, + {O1, ThrowList1} = + OpaqueFun(U1, U2, fun(E, Opaque) -> t_inf(Opaque, E, Opaques) end), + {O2, ThrowList2} + = OpaqueFun(U2, U1, fun(E, Opaque) -> t_inf(E, Opaque, Opaques) end), + {Union, ThrowList3} = inf_union(U1, U2, 0, [], [], Opaques), + ThrowList = lists:merge3(ThrowList1, ThrowList2, ThrowList3), + case t_sup([O1, O2, Union]) of + ?none when ThrowList =/= [] -> throw({pos, lists:usort(ThrowList)}); + Sup -> Sup + end. + +inf_union_collect([], _Opaque, _InfFun, InfList, ThrowList) -> + {t_sup(InfList), lists:usort(ThrowList)}; +inf_union_collect([?none|L], Opaque, InfFun, InfList, ThrowList) -> + inf_union_collect(L, Opaque, InfFun, [?none|InfList], ThrowList); +inf_union_collect([E|L], Opaque, InfFun, InfList, ThrowList) -> + try InfFun(E, Opaque)of + Inf -> + inf_union_collect(L, Opaque, InfFun, [Inf|InfList], ThrowList) + catch throw:{pos, Ns} -> + inf_union_collect(L, Opaque, InfFun, InfList, Ns ++ ThrowList) + end. + +inf_union([?none|Left1], [?none|Left2], N, Acc, ThrowList, Opaques) -> + inf_union(Left1, Left2, N, [?none|Acc], ThrowList, Opaques); +inf_union([T1|Left1], [T2|Left2], N, Acc, ThrowList, Opaques) -> + try t_inf(T1, T2, Opaques) of + ?none -> inf_union(Left1, Left2, N, [?none|Acc], ThrowList, Opaques); + T -> inf_union(Left1, Left2, N+1, [T|Acc], ThrowList, Opaques) + catch throw:{pos, Ns} -> + inf_union(Left1, Left2, N, [?none|Acc], Ns ++ ThrowList, Opaques) end; -inf_union([], [], N, Acc, _Mode) -> - if N =:= 0 -> ?none; +inf_union([], [], N, Acc, ThrowList, _Opaques) -> + if N =:= 0 -> {?none, ThrowList}; N =:= 1 -> [Type] = [T || T <- Acc, T =/= ?none], - Type; - N >= 2 -> ?union(lists:reverse(Acc)) + {Type, ThrowList}; + N >= 2 -> {?union(lists:reverse(Acc)), ThrowList} end. inf_bitstr(U1, B1, U2, B2) -> @@ -2489,77 +3301,33 @@ findfirst(N1, N2, U1, B1, U2, B2) -> %%----------------------------------------------------------------------------- %% Substitution of variables %% -%% Dialyzer versions prior to R15B used a dict data structure to map variables -%% to types. Hans Bolinder suggested the use of lists of Key-Value pairs for -%% this data structure and measurements showed a non-trivial speedup when using -%% them for operations within this module (e.g. in t_unify/2). However, there -%% is code outside erl_types that still passes a dict() in the 2nd argument. -%% So, for the time being, this module provides a t_subst/2 function for these -%% external calls and a clone of it (t_subst_kv/2) which is used from all calls -%% from within this module. This code duplication needs to be eliminated at -%% some point. - --spec t_subst(erl_type(), dict()) -> erl_type(). - -t_subst(T, Dict) -> + +-type subst_table() :: #{any() => erl_type()}. + +-spec t_subst(erl_type(), subst_table()) -> erl_type(). + +t_subst(T, Map) -> case t_has_var(T) of - true -> t_subst_dict(T, Dict); + true -> t_subst_aux(T, Map); false -> T end. -t_subst_dict(?var(Id), Dict) -> - case dict:find(Id, Dict) of - error -> ?any; - {ok, Type} -> Type - end; -t_subst_dict(?list(Contents, Termination, Size), Dict) -> - case t_subst_dict(Contents, Dict) of - ?none -> ?none; - NewContents -> - %% Be careful here to make the termination collapse if necessary. - case t_subst_dict(Termination, Dict) of - ?nil -> ?list(NewContents, ?nil, Size); - ?any -> ?list(NewContents, ?any, Size); - Other -> - ?list(NewContents2, NewTermination, _) = t_cons(NewContents, Other), - ?list(NewContents2, NewTermination, Size) - end - end; -t_subst_dict(?function(Domain, Range), Dict) -> - ?function(t_subst_dict(Domain, Dict), t_subst_dict(Range, Dict)); -t_subst_dict(?product(Types), Dict) -> - ?product([t_subst_dict(T, Dict) || T <- Types]); -t_subst_dict(?tuple(?any, ?any, ?any) = T, _Dict) -> - T; -t_subst_dict(?tuple(Elements, _Arity, _Tag), Dict) -> - t_tuple([t_subst_dict(E, Dict) || E <- Elements]); -t_subst_dict(?tuple_set(_) = TS, Dict) -> - t_sup([t_subst_dict(T, Dict) || T <- t_tuple_subtypes(TS)]); -t_subst_dict(T, _Dict) -> - T. - -spec subst_all_vars_to_any(erl_type()) -> erl_type(). subst_all_vars_to_any(T) -> - t_subst_kv(T, []). + t_subst(T, #{}). -t_subst_kv(T, KVMap) -> - case t_has_var(T) of - true -> t_subst_aux(T, KVMap); - false -> T - end. - -t_subst_aux(?var(Id), VarMap) -> - case lists:keyfind(Id, 1, VarMap) of - false -> ?any; - {Id, Type} -> Type +t_subst_aux(?var(Id), Map) -> + case maps:find(Id, Map) of + error -> ?any; + {ok, Type} -> Type end; -t_subst_aux(?list(Contents, Termination, Size), VarMap) -> - case t_subst_aux(Contents, VarMap) of +t_subst_aux(?list(Contents, Termination, Size), Map) -> + case t_subst_aux(Contents, Map) of ?none -> ?none; NewContents -> %% Be careful here to make the termination collapse if necessary. - case t_subst_aux(Termination, VarMap) of + case t_subst_aux(Termination, Map) of ?nil -> ?list(NewContents, ?nil, Size); ?any -> ?list(NewContents, ?any, Size); Other -> @@ -2567,19 +3335,29 @@ t_subst_aux(?list(Contents, Termination, Size), VarMap) -> ?list(NewContents2, NewTermination, Size) end end; -t_subst_aux(?function(Domain, Range), VarMap) -> - ?function(t_subst_aux(Domain, VarMap), t_subst_aux(Range, VarMap)); -t_subst_aux(?product(Types), VarMap) -> - ?product([t_subst_aux(T, VarMap) || T <- Types]); -t_subst_aux(?tuple(?any, ?any, ?any) = T, _VarMap) -> +t_subst_aux(?function(Domain, Range), Map) -> + ?function(t_subst_aux(Domain, Map), t_subst_aux(Range, Map)); +t_subst_aux(?product(Types), Map) -> + ?product([t_subst_aux(T, Map) || T <- Types]); +t_subst_aux(?tuple(?any, ?any, ?any) = T, _Map) -> T; -t_subst_aux(?tuple(Elements, _Arity, _Tag), VarMap) -> - t_tuple([t_subst_aux(E, VarMap) || E <- Elements]); -t_subst_aux(?tuple_set(_) = TS, VarMap) -> - t_sup([t_subst_aux(T, VarMap) || T <- t_tuple_subtypes(TS)]); -t_subst_aux(T, _VarMap) -> +t_subst_aux(?tuple(Elements, _Arity, _Tag), Map) -> + t_tuple([t_subst_aux(E, Map) || E <- Elements]); +t_subst_aux(?tuple_set(_) = TS, Map) -> + t_sup([t_subst_aux(T, Map) || T <- t_tuple_subtypes(TS)]); +t_subst_aux(?map(Pairs, DefK, DefV), Map) -> + t_map([{K, MNess, t_subst_aux(V, Map)} || {K, MNess, V} <- Pairs], + t_subst_aux(DefK, Map), t_subst_aux(DefV, Map)); +t_subst_aux(?opaque(Es), Map) -> + List = [Opaque#opaque{args = [t_subst_aux(Arg, Map) || Arg <- Args], + struct = t_subst_aux(S, Map)} || + Opaque = #opaque{args = Args, struct = S} <- set_to_list(Es)], + ?opaque(ordsets:from_list(List)); +t_subst_aux(?union(List), Map) -> + ?union([t_subst_aux(E, Map) || E <- List]); +t_subst_aux(T, _Map) -> T. - + %%----------------------------------------------------------------------------- %% Unification %% @@ -2589,112 +3367,169 @@ t_subst_aux(T, _VarMap) -> -spec t_unify(erl_type(), erl_type()) -> t_unify_ret(). t_unify(T1, T2) -> - t_unify(T1, T2, []). - --spec t_unify(erl_type(), erl_type(), [erl_type()]) -> t_unify_ret(). + {T, VarMap} = t_unify(T1, T2, #{}), + {t_subst(T, VarMap), lists:keysort(1, maps:to_list(VarMap))}. -t_unify(T1, T2, Opaques) -> - {T, VarMap} = t_unify(T1, T2, [], Opaques), - {t_subst_kv(T, VarMap), lists:keysort(1, VarMap)}. - -t_unify(?var(Id) = T, ?var(Id), VarMap, _Opaques) -> +t_unify(?var(Id) = T, ?var(Id), VarMap) -> {T, VarMap}; -t_unify(?var(Id1) = T, ?var(Id2), VarMap, Opaques) -> - case lists:keyfind(Id1, 1, VarMap) of - false -> - case lists:keyfind(Id2, 1, VarMap) of - false -> {T, [{Id2, T} | VarMap]}; - {Id2, Type} -> t_unify(T, Type, VarMap, Opaques) +t_unify(?var(Id1) = T, ?var(Id2), VarMap) -> + case maps:find(Id1, VarMap) of + error -> + case maps:find(Id2, VarMap) of + error -> {T, VarMap#{Id2 => T}}; + {ok, Type} -> t_unify(T, Type, VarMap) end; - {Id1, Type1} -> - case lists:keyfind(Id2, 1, VarMap) of - false -> {Type1, [{Id2, T} | VarMap]}; - {Id2, Type2} -> t_unify(Type1, Type2, VarMap, Opaques) + {ok, Type1} -> + case maps:find(Id2, VarMap) of + error -> {Type1, VarMap#{Id2 => T}}; + {ok, Type2} -> t_unify(Type1, Type2, VarMap) end end; -t_unify(?var(Id), Type, VarMap, Opaques) -> - case lists:keyfind(Id, 1, VarMap) of - false -> {Type, [{Id, Type} | VarMap]}; - {Id, VarType} -> t_unify(VarType, Type, VarMap, Opaques) +t_unify(?var(Id), Type, VarMap) -> + case maps:find(Id, VarMap) of + error -> {Type, VarMap#{Id => Type}}; + {ok, VarType} -> t_unify(VarType, Type, VarMap) end; -t_unify(Type, ?var(Id), VarMap, Opaques) -> - case lists:keyfind(Id, 1, VarMap) of - false -> {Type, [{Id, Type} | VarMap]}; - {Id, VarType} -> t_unify(VarType, Type, VarMap, Opaques) +t_unify(Type, ?var(Id), VarMap) -> + case maps:find(Id, VarMap) of + error -> {Type, VarMap#{Id => Type}}; + {ok, VarType} -> t_unify(VarType, Type, VarMap) end; -t_unify(?function(Domain1, Range1), ?function(Domain2, Range2), VarMap, Opaques) -> - {Domain, VarMap1} = t_unify(Domain1, Domain2, VarMap, Opaques), - {Range, VarMap2} = t_unify(Range1, Range2, VarMap1, Opaques), +t_unify(?function(Domain1, Range1), ?function(Domain2, Range2), VarMap) -> + {Domain, VarMap1} = t_unify(Domain1, Domain2, VarMap), + {Range, VarMap2} = t_unify(Range1, Range2, VarMap1), {?function(Domain, Range), VarMap2}; t_unify(?list(Contents1, Termination1, Size), - ?list(Contents2, Termination2, Size), VarMap, Opaques) -> - {Contents, VarMap1} = t_unify(Contents1, Contents2, VarMap, Opaques), - {Termination, VarMap2} = t_unify(Termination1, Termination2, VarMap1, Opaques), + ?list(Contents2, Termination2, Size), VarMap) -> + {Contents, VarMap1} = t_unify(Contents1, Contents2, VarMap), + {Termination, VarMap2} = t_unify(Termination1, Termination2, VarMap1), {?list(Contents, Termination, Size), VarMap2}; -t_unify(?product(Types1), ?product(Types2), VarMap, Opaques) -> - {Types, VarMap1} = unify_lists(Types1, Types2, VarMap, Opaques), +t_unify(?product(Types1), ?product(Types2), VarMap) -> + {Types, VarMap1} = unify_lists(Types1, Types2, VarMap), {?product(Types), VarMap1}; -t_unify(?tuple(?any, ?any, ?any) = T, ?tuple(?any, ?any, ?any), VarMap, _Opaques) -> +t_unify(?tuple(?any, ?any, ?any) = T, ?tuple(?any, ?any, ?any), VarMap) -> {T, VarMap}; t_unify(?tuple(Elements1, Arity, _), - ?tuple(Elements2, Arity, _), VarMap, Opaques) when Arity =/= ?any -> - {NewElements, VarMap1} = unify_lists(Elements1, Elements2, VarMap, Opaques), + ?tuple(Elements2, Arity, _), VarMap) when Arity =/= ?any -> + {NewElements, VarMap1} = unify_lists(Elements1, Elements2, VarMap), {t_tuple(NewElements), VarMap1}; t_unify(?tuple_set([{Arity, _}]) = T1, - ?tuple(_, Arity, _) = T2, VarMap, Opaques) when Arity =/= ?any -> - unify_tuple_set_and_tuple(T1, T2, VarMap, Opaques); + ?tuple(_, Arity, _) = T2, VarMap) when Arity =/= ?any -> + unify_tuple_set_and_tuple1(T1, T2, VarMap); t_unify(?tuple(_, Arity, _) = T1, - ?tuple_set([{Arity, _}]) = T2, VarMap, Opaques) when Arity =/= ?any -> - unify_tuple_set_and_tuple(T2, T1, VarMap, Opaques); -t_unify(?tuple_set(List1), ?tuple_set(List2), VarMap, Opaques) -> - {Tuples, NewVarMap} = - unify_lists(lists:append([T || {_Arity, T} <- List1]), - lists:append([T || {_Arity, T} <- List2]), VarMap, Opaques), - {t_sup(Tuples), NewVarMap}; -t_unify(?opaque(Elements) = T, ?opaque(Elements), VarMap, _Opaques) -> - {T, VarMap}; -t_unify(?opaque(_) = T1, ?opaque(_) = T2, _VarMap, _Opaques) -> - throw({mismatch, T1, T2}); -t_unify(Type, ?opaque(_) = OpType, VarMap, Opaques) -> - t_unify_with_opaque(Type, OpType, VarMap, Opaques); -t_unify(?opaque(_) = OpType, Type, VarMap, Opaques) -> - t_unify_with_opaque(Type, OpType, VarMap, Opaques); -t_unify(T, T, VarMap, _Opaques) -> + ?tuple_set([{Arity, _}]) = T2, VarMap) when Arity =/= ?any -> + unify_tuple_set_and_tuple2(T1, T2, VarMap); +t_unify(?tuple_set(List1) = T1, ?tuple_set(List2) = T2, VarMap) -> + try + unify_lists(lists:append([T || {_Arity, T} <- List1]), + lists:append([T || {_Arity, T} <- List2]), VarMap) + of + {Tuples, NewVarMap} -> {t_sup(Tuples), NewVarMap} + catch _:_ -> throw({mismatch, T1, T2}) + end; +t_unify(?map(_, ADefK, ADefV) = A, ?map(_, BDefK, BDefV) = B, VarMap0) -> + {DefK, VarMap1} = t_unify(ADefK, BDefK, VarMap0), + {DefV, VarMap2} = t_unify(ADefV, BDefV, VarMap1), + {Pairs, VarMap} = + map_pairwise_merge_foldr( + fun(K, MNess, V1, MNess, V2, {Pairs0, VarMap3}) -> + %% We know that the keys unify and do not contain variables, or they + %% would not be singletons + %% TODO: Should V=?none (known missing keys) be handled special? + {V, VarMap4} = t_unify(V1, V2, VarMap3), + {[{K,MNess,V}|Pairs0], VarMap4}; + (K, _, V1, _, V2, {Pairs0, VarMap3}) -> + %% One mandatory and one optional; what should be done in this case? + {V, VarMap4} = t_unify(V1, V2, VarMap3), + {[{K,?mand,V}|Pairs0], VarMap4} + end, {[], VarMap2}, A, B), + {t_map(Pairs, DefK, DefV), VarMap}; +t_unify(?opaque(_) = T1, ?opaque(_) = T2, VarMap) -> + t_unify(t_opaque_structure(T1), t_opaque_structure(T2), VarMap); +t_unify(T1, ?opaque(_) = T2, VarMap) -> + t_unify(T1, t_opaque_structure(T2), VarMap); +t_unify(?opaque(_) = T1, T2, VarMap) -> + t_unify(t_opaque_structure(T1), T2, VarMap); +t_unify(T, T, VarMap) -> {T, VarMap}; -t_unify(T1, T2, _, _) -> +t_unify(?union(_)=T1, ?union(_)=T2, VarMap) -> + {Type1, Type2} = unify_union2(T1, T2), + t_unify(Type1, Type2, VarMap); +t_unify(?union(_)=T1, T2, VarMap) -> + t_unify(unify_union1(T1, T1, T2), T2, VarMap); +t_unify(T1, ?union(_)=T2, VarMap) -> + t_unify(T1, unify_union1(T2, T1, T2), VarMap); +t_unify(T1, T2, _) -> throw({mismatch, T1, T2}). -t_unify_with_opaque(Type, OpType, VarMap, Opaques) -> - case lists:member(OpType, Opaques) of +unify_union2(?union(List1)=T1, ?union(List2)=T2) -> + case {unify_union(List1), unify_union(List2)} of + {{yes, Type1}, {yes, Type2}} -> {Type1, Type2}; + {{yes, Type1}, no} -> {Type1, T2}; + {no, {yes, Type2}} -> {T1, Type2}; + {no, no} -> throw({mismatch, T1, T2}) + end. + +unify_union1(?union(List), T1, T2) -> + case unify_union(List) of + {yes, Type} -> Type; + no -> throw({mismatch, T1, T2}) + end. + +unify_union(List) -> + [A,B,F,I,L,N,T,M,O,Map] = List, + if O =:= ?none -> no; true -> - Struct = t_opaque_structure(OpType), - try t_unify(Type, Struct, VarMap, Opaques) of - {_T, VarMap1} -> {OpType, VarMap1} - catch - throw:{mismatch, _T1, _T2} -> - case t_inf(OpType, Type, opaque) of - ?none -> throw({mismatch, Type, OpType}); - _ -> {OpType, VarMap} - end - end; - false -> - throw({mismatch, Type, OpType}) + S = t_opaque_structure(O), + {yes, t_sup([A,B,F,I,L,N,T,M,S,Map])} end. -unify_tuple_set_and_tuple(?tuple_set([{Arity, List}]), - ?tuple(Elements2, Arity, _), VarMap, Opaques) -> +-spec is_opaque_type(erl_type(), [erl_type()]) -> boolean(). + +%% An opaque type is a union of types. Returns true iff any of the type +%% names (Module and Name) of the first argument (the opaque type to +%% check) occurs in any of the opaque types of the second argument. +is_opaque_type(?opaque(Elements), Opaques) -> + lists:any(fun(Opaque) -> is_opaque_type2(Opaque, Opaques) end, Elements). + +is_opaque_type2(#opaque{mod = Mod1, name = Name1, args = Args1}, Opaques) -> + F1 = fun(?opaque(Es)) -> + F2 = fun(#opaque{mod = Mod, name = Name, args = Args}) -> + is_type_name(Mod1, Name1, Args1, Mod, Name, Args) + end, + lists:any(F2, Es) + end, + lists:any(F1, Opaques). + +is_type_name(Mod, Name, Args1, Mod, Name, Args2) -> + length(Args1) =:= length(Args2); +is_type_name(_Mod1, _Name1, _Args1, _Mod2, _Name2, _Args2) -> + false. + +%% Two functions since t_unify is not symmetric. +unify_tuple_set_and_tuple1(?tuple_set([{Arity, List}]), + ?tuple(Elements2, Arity, _), VarMap) -> %% Can only work if the single tuple has variables at correct places. %% Collapse the tuple set. - {NewElements, VarMap1} = unify_lists(sup_tuple_elements(List), Elements2, VarMap, Opaques), + {NewElements, VarMap1} = + unify_lists(sup_tuple_elements(List), Elements2, VarMap), {t_tuple(NewElements), VarMap1}. -unify_lists(L1, L2, VarMap, Opaques) -> - unify_lists(L1, L2, VarMap, [], Opaques). +unify_tuple_set_and_tuple2(?tuple(Elements2, Arity, _), + ?tuple_set([{Arity, List}]), VarMap) -> + %% Can only work if the single tuple has variables at correct places. + %% Collapse the tuple set. + {NewElements, VarMap1} = + unify_lists(Elements2, sup_tuple_elements(List), VarMap), + {t_tuple(NewElements), VarMap1}. -unify_lists([T1|Left1], [T2|Left2], VarMap, Acc, Opaques) -> - {NewT, NewVarMap} = t_unify(T1, T2, VarMap, Opaques), - unify_lists(Left1, Left2, NewVarMap, [NewT|Acc], Opaques); -unify_lists([], [], VarMap, Acc, _Opaques) -> +unify_lists(L1, L2, VarMap) -> + unify_lists(L1, L2, VarMap, []). + +unify_lists([T1|Left1], [T2|Left2], VarMap, Acc) -> + {NewT, NewVarMap} = t_unify(T1, T2, VarMap), + unify_lists(Left1, Left2, NewVarMap, [NewT|Acc]); +unify_lists([], [], VarMap, Acc) -> {lists:reverse(Acc), VarMap}. %%t_assign_variables_to_subtype(T1, T2) -> @@ -2812,7 +3647,7 @@ t_subtract_list(T, []) -> -spec t_subtract(erl_type(), erl_type()) -> erl_type(). t_subtract(_, ?any) -> ?none; -t_subtract(_, ?var(_)) -> ?none; +t_subtract(T, ?var(_)) -> T; t_subtract(?any, _) -> ?any; t_subtract(?var(_) = T, _) -> T; t_subtract(T, ?unit) -> T; @@ -2836,11 +3671,12 @@ t_subtract(?identifier(Set1), ?identifier(Set2)) -> ?none -> ?none; Set -> ?identifier(Set) end; -t_subtract(?opaque(Set1), ?opaque(Set2)) -> - case set_subtract(Set1, Set2) of - ?none -> ?none; - Set -> ?opaque(Set) - end; +t_subtract(?opaque(_)=T1, ?opaque(_)=T2) -> + opaque_subtract(T1, t_opaque_structure(T2)); +t_subtract(?opaque(_)=T1, T2) -> + opaque_subtract(T1, T2); +t_subtract(T1, ?opaque(_)=T2) -> + t_subtract(T1, t_opaque_structure(T2)); t_subtract(?matchstate(Pres1, Slots1), ?matchstate(Pres2, _Slots2)) -> Pres = t_subtract(Pres1, Pres2), case t_is_none(Pres) of @@ -2964,6 +3800,50 @@ t_subtract(?product(Elements1) = T1, ?product(Elements2)) -> _ -> T1 end end; +t_subtract(?map(APairs, ADefK, ADefV) = A, ?map(_, BDefK, BDefV) = B) -> + case t_is_subtype(ADefK, BDefK) andalso t_is_subtype(ADefV, BDefV) of + false -> A; + true -> + %% We fold over the maps to produce a list of constraints, where + %% constraints are additional key-value pairs to put in Pairs. Only one + %% constraint need to be applied to produce a type that excludes the + %% right-hand-side type, so if more than one constraint is produced, we + %% just return the left-hand-side argument. + %% + %% Each case of the fold may either conclude that + %% * The arguments constrain A at least as much as B, i.e. that A so far + %% is a subtype of B. In that case they return false + %% * That for the particular arguments, A being a subtype of B does not + %% hold, but the infinimum of A and B is nonempty, and by narrowing a + %% pair in A, we can create a type that excludes some elements in the + %% infinumum. In that case, they will return that pair. + %% * That for the particular arguments, A being a subtype of B does not + %% hold, and either the infinumum of A and B is empty, or it is not + %% possible with the current representation to create a type that + %% excludes elements from B without also excluding elements that are + %% only in A. In that case, it will return the pair from A unchanged. + case + map_pairwise_merge( + %% If V1 is a subtype of V2, the case that K does not exist in A + %% remain. + fun(K, ?opt, V1, ?mand, V2) -> {K, ?opt, t_subtract(V1, V2)}; + (K, _, V1, _, V2) -> + %% If we subtract an optional key, that leaves a mandatory key + case t_subtract(V1, V2) of + ?none -> false; + Partial -> {K, ?mand, Partial} + end + end, A, B) + of + %% We produce a list of keys that are constrained. As only one of + %% these should apply at a time, we can't represent the difference if + %% more than one constraint is produced. If we applied all of them, + %% that would make an underapproximation, which we must not do. + [] -> ?none; %% A is a subtype of B + [E] -> t_map(mapdict_store(E, APairs), ADefK, ADefV); + _ -> A + end + end; t_subtract(?product(P1), _) -> ?product(P1); t_subtract(T, ?product(_)) -> @@ -2975,6 +3855,17 @@ t_subtract(T1, T2) -> ?union(U2) = force_union(T2), subtract_union(U1, U2). +-spec opaque_subtract(erl_type(), erl_type()) -> erl_type(). + +opaque_subtract(?opaque(Set1), T2) -> + List = [T1#opaque{struct = Sub} || + #opaque{struct = S1}=T1 <- set_to_list(Set1), + not t_is_none(Sub = t_subtract(S1, T2))], + case List of + [] -> ?none; + _ -> ?opaque(ordsets:from_list(List)) + end. + -spec t_subtract_lists([erl_type()], [erl_type()]) -> [erl_type()]. t_subtract_lists(L1, L2) -> @@ -2990,7 +3881,18 @@ t_subtract_lists([], [], Acc) -> -spec subtract_union([erl_type(),...], [erl_type(),...]) -> erl_type(). subtract_union(U1, U2) -> - subtract_union(U1, U2, 0, []). + [A1,B1,F1,I1,L1,N1,T1,M1,O1,Map1] = U1, + [A2,B2,F2,I2,L2,N2,T2,M2,O2,Map2] = U2, + List1 = [A1,B1,F1,I1,L1,N1,T1,M1,?none,Map1], + List2 = [A2,B2,F2,I2,L2,N2,T2,M2,?none,Map2], + Sub1 = subtract_union(List1, List2, 0, []), + O = if O1 =:= ?none -> O1; + true -> t_subtract(O1, ?union(U2)) + end, + Sub2 = if O2 =:= ?none -> Sub1; + true -> t_subtract(Sub1, t_opaque_structure(O2)) + end, + t_sup(O, Sub2). -spec subtract_union([erl_type()], [erl_type()], non_neg_integer(), [erl_type()]) -> erl_type(). @@ -3051,27 +3953,46 @@ t_is_equal(_, _) -> false. t_is_subtype(T1, T2) -> Inf = t_inf(T1, T2), - t_is_equal(T1, Inf). + subtype_is_equal(T1, Inf). + +%% The subtype relation has to behave correctly irrespective of opaque +%% types. +subtype_is_equal(T, T) -> true; +subtype_is_equal(T1, T2) -> + t_is_equal(case t_contains_opaque(T1) of + true -> t_unopaque(T1); + false -> T1 + end, + case t_contains_opaque(T2) of + true -> t_unopaque(T2); + false -> T2 + end). -spec t_is_instance(erl_type(), erl_type()) -> boolean(). +%% XXX. To be removed. t_is_instance(ConcreteType, Type) -> t_is_subtype(ConcreteType, t_unopaque(Type)). +-spec t_do_overlap(erl_type(), erl_type()) -> boolean(). + +t_do_overlap(TypeA, TypeB) -> + not (t_is_none_or_unit(t_inf(TypeA, TypeB))). + -spec t_unopaque(erl_type()) -> erl_type(). t_unopaque(T) -> t_unopaque(T, 'universe'). --spec t_unopaque(erl_type(), 'universe' | [erl_type()]) -> erl_type(). +-spec t_unopaque(erl_type(), opaques()) -> erl_type(). t_unopaque(?opaque(_) = T, Opaques) -> - case Opaques =:= universe orelse lists:member(T, Opaques) of + case Opaques =:= 'universe' orelse is_opaque_type(T, Opaques) of true -> t_unopaque(t_opaque_structure(T), Opaques); - false -> T % XXX: needs revision for parametric opaque data types + false -> T end; t_unopaque(?list(ElemT, Termination, Sz), Opaques) -> - ?list(t_unopaque(ElemT, Opaques), Termination, Sz); + ?list(t_unopaque(ElemT, Opaques), t_unopaque(Termination, Opaques), Sz); t_unopaque(?tuple(?any, _, _) = T, _) -> T; t_unopaque(?tuple(ArgTs, Sz, Tag), Opaques) when is_list(ArgTs) -> NewArgTs = [t_unopaque(A, Opaques) || A <- ArgTs], @@ -3080,14 +4001,25 @@ t_unopaque(?tuple_set(Set), Opaques) -> NewSet = [{Sz, [t_unopaque(T, Opaques) || T <- Tuples]} || {Sz, Tuples} <- Set], ?tuple_set(NewSet); -t_unopaque(?union([A,B,F,I,L,N,T,M,O,R]), Opaques) -> +t_unopaque(?product(Types), Opaques) -> + ?product([t_unopaque(T, Opaques) || T <- Types]); +t_unopaque(?function(Domain, Range), Opaques) -> + ?function(t_unopaque(Domain, Opaques), t_unopaque(Range, Opaques)); +t_unopaque(?union([A,B,F,I,L,N,T,M,O,Map]), Opaques) -> UL = t_unopaque(L, Opaques), UT = t_unopaque(T, Opaques), - UO = case O of - ?none -> []; - ?opaque(Os) -> [t_unopaque(S, Opaques) || #opaque{struct = S} <- Os] - end, - t_sup([?union([A,B,F,I,UL,N,UT,M,?none,R])|UO]); + UF = t_unopaque(F, Opaques), + UM = t_unopaque(M, Opaques), + UMap = t_unopaque(Map, Opaques), + {OF,UO} = case t_unopaque(O, Opaques) of + ?opaque(_) = O1 -> {O1, []}; + Type -> {?none, [Type]} + end, + t_sup([?union([A,B,UF,I,UL,N,UT,UM,OF,UMap])|UO]); +t_unopaque(?map(Pairs,DefK,DefV), Opaques) -> + t_map([{K, MNess, t_unopaque(V, Opaques)} || {K, MNess, V} <- Pairs], + t_unopaque(DefK, Opaques), + t_unopaque(DefV, Opaques)); t_unopaque(T, _) -> T. @@ -3133,6 +4065,22 @@ t_limit_k(?product(Elements), K) -> ?product([t_limit_k(X, K - 1) || X <- Elements]); t_limit_k(?union(Elements), K) -> ?union([t_limit_k(X, K) || X <- Elements]); +t_limit_k(?opaque(Es), K) -> + List = [begin + NewS = t_limit_k(S, K), + Opaque#opaque{struct = NewS} + end || #opaque{struct = S} = Opaque <- set_to_list(Es)], + ?opaque(ordsets:from_list(List)); +t_limit_k(?map(Pairs0, DefK0, DefV0), K) -> + Fun = fun({EK, MNess, EV}, {Exact, DefK1, DefV1}) -> + LV = t_limit_k(EV, K - 1), + case t_limit_k(EK, K - 1) of + EK -> {[{EK,MNess,LV}|Exact], DefK1, DefV1}; + LK -> {Exact, t_sup(LK, DefK1), t_sup(LV, DefV1)} + end + end, + {Pairs, DefK2, DefV2} = lists:foldr(Fun, {[], DefK0, DefV0}, Pairs0), + t_map(Pairs, t_limit_k(DefK2, K - 1), t_limit_k(DefV2, K - 1)); t_limit_k(T, _K) -> T. %%============================================================================ @@ -3141,7 +4089,7 @@ t_limit_k(T, _K) -> T. %% %%============================================================================ --spec t_abstract_records(erl_type(), dict()) -> erl_type(). +-spec t_abstract_records(erl_type(), type_table()) -> erl_type(). t_abstract_records(?list(Contents, Termination, Size), RecDict) -> case t_abstract_records(Contents, RecDict) of @@ -3166,15 +4114,17 @@ t_abstract_records(?union(Types), RecDict) -> t_abstract_records(?tuple(?any, ?any, ?any) = T, _RecDict) -> T; t_abstract_records(?tuple(Elements, Arity, ?atom(_) = Tag), RecDict) -> - [TagAtom] = t_atom_vals(Tag), + [TagAtom] = atom_vals(Tag), case lookup_record(TagAtom, Arity - 1, RecDict) of error -> t_tuple([t_abstract_records(E, RecDict) || E <- Elements]); - {ok, Fields} -> t_tuple([Tag|[T || {_Name, T} <- Fields]]) + {ok, Fields} -> t_tuple([Tag|[T || {_Name, _Abstr, T} <- Fields]]) end; t_abstract_records(?tuple(Elements, _Arity, _Tag), RecDict) -> t_tuple([t_abstract_records(E, RecDict) || E <- Elements]); t_abstract_records(?tuple_set(_) = Tuples, RecDict) -> t_sup([t_abstract_records(T, RecDict) || T <- t_tuple_subtypes(Tuples)]); +t_abstract_records(?opaque(_)=Type, RecDict) -> + t_abstract_records(t_opaque_structure(Type), RecDict); t_abstract_records(T, _RecDict) -> T. @@ -3197,6 +4147,17 @@ t_map(Fun, ?tuple(Elements, _Arity, _Tag)) -> Fun(t_tuple([t_map(Fun, E) || E <- Elements])); t_map(Fun, ?tuple_set(_) = Tuples) -> Fun(t_sup([t_map(Fun, T) || T <- t_tuple_subtypes(Tuples)])); +t_map(Fun, ?opaque(Set)) -> + L = [Opaque#opaque{struct = NewS} || + #opaque{struct = S} = Opaque <- set_to_list(Set), + not t_is_none(NewS = t_map(Fun, S))], + Fun(case L of + [] -> ?none; + _ -> ?opaque(ordsets:from_list(L)) + end); +t_map(Fun, ?map(Pairs,DefK,DefV)) -> + %% TODO: + Fun(t_map(Pairs, Fun(DefK), Fun(DefV))); t_map(Fun, T) -> Fun(T). @@ -3211,7 +4172,7 @@ t_map(Fun, T) -> t_to_string(T) -> t_to_string(T, dict:new()). --spec t_to_string(erl_type(), dict()) -> string(). +-spec t_to_string(erl_type(), type_table()) -> string(). t_to_string(?any, _RecDict) -> "any()"; @@ -3238,11 +4199,11 @@ t_to_string(?bitstr(8, 0), _RecDict) -> t_to_string(?bitstr(1, 0), _RecDict) -> "bitstring()"; t_to_string(?bitstr(0, B), _RecDict) -> - lists:flatten(io_lib:format("<<_:~w>>", [B])); + flat_format("<<_:~w>>", [B]); t_to_string(?bitstr(U, 0), _RecDict) -> - lists:flatten(io_lib:format("<<_:_*~w>>", [U])); + flat_format("<<_:_*~w>>", [U]); t_to_string(?bitstr(U, B), _RecDict) -> - lists:flatten(io_lib:format("<<_:~w,_:_*~w>>", [B, U])); + flat_format("<<_:~w,_:_*~w>>", [B, U]); t_to_string(?function(?any, ?any), _RecDict) -> "fun()"; t_to_string(?function(?any, Range), RecDict) -> @@ -3254,18 +4215,16 @@ t_to_string(?identifier(Set), _RecDict) -> case Set of ?any -> "identifier()"; _ -> - string:join([io_lib:format("~w()", [T]) || T <- set_to_list(Set)], " | ") + string:join([flat_format("~w()", [T]) || T <- set_to_list(Set)], " | ") end; -t_to_string(?opaque(Set), _RecDict) -> - string:join([case is_opaque_builtin(Mod, Name) of - true -> io_lib:format("~w()", [Name]); - false -> io_lib:format("~w:~w()", [Mod, Name]) - end - || #opaque{mod = Mod, name = Name} <- set_to_list(Set)], +t_to_string(?opaque(Set), RecDict) -> + string:join([opaque_type(Mod, Name, Args, S, RecDict) || + #opaque{mod = Mod, name = Name, struct = S, args = Args} + <- set_to_list(Set)], " | "); t_to_string(?matchstate(Pres, Slots), RecDict) -> - io_lib:format("ms(~s,~s)", [t_to_string(Pres, RecDict), - t_to_string(Slots,RecDict)]); + flat_format("ms(~s,~s)", [t_to_string(Pres, RecDict), + t_to_string(Slots,RecDict)]); t_to_string(?nil, _RecDict) -> "[]"; t_to_string(?nonempty_list(Contents, Termination), RecDict) -> @@ -3281,7 +4240,9 @@ t_to_string(?nonempty_list(Contents, Termination), RecDict) -> case Contents =:= ?any of true -> ok; false -> - erlang:error({illegal_list, ?nonempty_list(Contents, Termination)}) + %% XXX. See comment below. + %% erlang:error({illegal_list, ?nonempty_list(Contents, Termination)}) + ok end, "nonempty_maybe_improper_list()"; _ -> @@ -3304,11 +4265,14 @@ t_to_string(?list(Contents, Termination, ?unknown_qual), RecDict) -> end; ?any -> %% Just a safety check. + %% XXX. Types such as "maybe_improper_list(integer(), any())" + %% are OK, but cannot be printed!? case Contents =:= ?any of true -> ok; false -> - L = ?list(Contents, Termination, ?unknown_qual), - erlang:error({illegal_list, L}) + ok + %% L = ?list(Contents, Termination, ?unknown_qual), + %% erlang:error({illegal_list, L}) end, "maybe_improper_list()"; _ -> @@ -3329,27 +4293,33 @@ t_to_string(?integer_pos, _RecDict) -> "pos_integer()"; t_to_string(?integer_non_neg, _RecDict) -> "non_neg_integer()"; t_to_string(?integer_neg, _RecDict) -> "neg_integer()"; t_to_string(?int_range(From, To), _RecDict) -> - lists:flatten(io_lib:format("~w..~w", [From, To])); + flat_format("~w..~w", [From, To]); t_to_string(?integer(?any), _RecDict) -> "integer()"; t_to_string(?float, _RecDict) -> "float()"; t_to_string(?number(?any, ?unknown_qual), _RecDict) -> "number()"; t_to_string(?product(List), RecDict) -> "<" ++ comma_sequence(List, RecDict) ++ ">"; -t_to_string(?remote(Set), RecDict) -> - string:join([case Args =:= [] of - true -> io_lib:format("~w:~w()", [Mod, Name]); - false -> - ArgString = comma_sequence(Args, RecDict), - io_lib:format("~w:~w(~s)", [Mod, Name, ArgString]) - end - || #remote{mod = Mod, name = Name, args = Args} <- - set_to_list(Set)], - " | "); +t_to_string(?map([],?any,?any), _RecDict) -> "map()"; +t_to_string(?map(Pairs0,DefK,DefV), RecDict) -> + {Pairs, ExtraEl} = + case {DefK, DefV} of + {?none, ?none} -> {Pairs0, []}; + _ -> {Pairs0 ++ [{DefK,?opt,DefV}], []} + end, + Tos = fun(T) -> case T of + ?any -> "_"; + _ -> t_to_string(T, RecDict) + end end, + StrMand = [{Tos(K),Tos(V)}||{K,?mand,V}<-Pairs], + StrOpt = [{Tos(K),Tos(V)}||{K,?opt,V}<-Pairs], + "#{" ++ string:join([K ++ ":=" ++ V||{K,V}<-StrMand] + ++ [K ++ "=>" ++ V||{K,V}<-StrOpt] + ++ ExtraEl, ", ") ++ "}"; t_to_string(?tuple(?any, ?any, ?any), _RecDict) -> "tuple()"; t_to_string(?tuple(Elements, _Arity, ?any), RecDict) -> "{" ++ comma_sequence(Elements, RecDict) ++ "}"; t_to_string(?tuple(Elements, Arity, Tag), RecDict) -> - [TagAtom] = t_atom_vals(Tag), + [TagAtom] = atom_vals(Tag), case lookup_record(TagAtom, Arity-1, RecDict) of error -> "{" ++ comma_sequence(Elements, RecDict) ++ "}"; {ok, FieldNames} -> @@ -3360,41 +4330,43 @@ t_to_string(?tuple_set(_) = T, RecDict) -> t_to_string(?union(Types), RecDict) -> union_sequence([T || T <- Types, T =/= ?none], RecDict); t_to_string(?var(Id), _RecDict) when is_atom(Id) -> - io_lib:format("~s", [atom_to_list(Id)]); + flat_format("~s", [atom_to_list(Id)]); t_to_string(?var(Id), _RecDict) when is_integer(Id) -> - io_lib:format("var(~w)", [Id]). + flat_format("var(~w)", [Id]). + record_to_string(Tag, [_|Fields], FieldNames, RecDict) -> FieldStrings = record_fields_to_string(Fields, FieldNames, RecDict, []), "#" ++ atom_to_string(Tag) ++ "{" ++ string:join(FieldStrings, ",") ++ "}". -record_fields_to_string([F|Fs], [{FName, _DefType}|FDefs], RecDict, Acc) -> +record_fields_to_string([F|Fs], [{FName, _Abstr, DefType}|FDefs], + RecDict, Acc) -> NewAcc = - case t_is_any(F) orelse t_is_atom('undefined', F) of + case + t_is_equal(F, t_any()) orelse + (t_is_any_atom('undefined', F) andalso + not t_is_none(t_inf(F, DefType))) + of true -> Acc; false -> StrFV = atom_to_string(FName) ++ "::" ++ t_to_string(F, RecDict), - %% ActualDefType = t_subtract(DefType, t_atom('undefined')), - %% Str = case t_is_any(ActualDefType) of - %% true -> StrFV; - %% false -> StrFV ++ "::" ++ t_to_string(ActualDefType, RecDict) - %% end, [StrFV|Acc] end, record_fields_to_string(Fs, FDefs, RecDict, NewAcc); record_fields_to_string([], [], _RecDict, Acc) -> lists:reverse(Acc). --spec record_field_diffs_to_string(erl_type(), dict()) -> string(). +-spec record_field_diffs_to_string(erl_type(), type_table()) -> string(). record_field_diffs_to_string(?tuple([_|Fs], Arity, Tag), RecDict) -> - [TagAtom] = t_atom_vals(Tag), + [TagAtom] = atom_vals(Tag), {ok, FieldNames} = lookup_record(TagAtom, Arity-1, RecDict), %% io:format("RecCElems = ~p\nRecTypes = ~p\n", [Fs, FieldNames]), FieldDiffs = field_diffs(Fs, FieldNames, RecDict, []), string:join(FieldDiffs, " and "). -field_diffs([F|Fs], [{FName, DefType}|FDefs], RecDict, Acc) -> +field_diffs([F|Fs], [{FName, _Abstr, DefType}|FDefs], RecDict, Acc) -> + %% Don't care about opaqueness for now. NewAcc = case not t_is_none(t_inf(F, DefType)) of true -> Acc; @@ -3417,419 +4389,752 @@ union_sequence(Types, RecDict) -> List = [t_to_string(T, RecDict) || T <- Types], string:join(List, " | "). +-ifdef(DEBUG). +opaque_type(Mod, Name, _Args, S, RecDict) -> + ArgsString = comma_sequence(_Args, RecDict), + String = t_to_string(S, RecDict), + opaque_name(Mod, Name, ArgsString) ++ "[" ++ String ++ "]". +-else. +opaque_type(Mod, Name, Args, _S, RecDict) -> + ArgsString = comma_sequence(Args, RecDict), + opaque_name(Mod, Name, ArgsString). +-endif. + +opaque_name(Mod, Name, Extra) -> + S = mod_name(Mod, Name), + flat_format("~s(~s)", [S, Extra]). + +mod_name(Mod, Name) -> + flat_format("~w:~w", [Mod, Name]). + %%============================================================================= %% %% Build a type from parse forms. %% %%============================================================================= --spec t_from_form(parse_form()) -> erl_type(). - -t_from_form(Form) -> - t_from_form(Form, dict:new()). - --spec t_from_form(parse_form(), dict()) -> erl_type(). - -t_from_form(Form, RecDict) -> - t_from_form(Form, RecDict, dict:new()). - --spec t_from_form(parse_form(), dict(), dict()) -> erl_type(). - -t_from_form(Form, RecDict, VarDict) -> - {T, _R} = t_from_form(Form, [], false, RecDict, VarDict), - T. +-type type_names() :: [type_key() | record_key()]. + +-type mta() :: {module(), atom(), arity()}. +-type mra() :: {module(), atom(), arity()}. +-type site() :: {'type', mta()} | {'spec', mfa()} | {'record', mra()}. +-type cache_key() :: {module(), atom(), expand_depth(), + [erl_type()], type_names()}. +-opaque cache() :: #{cache_key() => {erl_type(), expand_limit()}}. + +-spec t_from_form(parse_form(), sets:set(mfa()), site(), mod_records(), + var_table(), cache()) -> {erl_type(), cache()}. + +t_from_form(Form, ExpTypes, Site, RecDict, VarTab, Cache) -> + t_from_form1(Form, ExpTypes, Site, RecDict, VarTab, Cache). + +%% Replace external types with with none(). +-spec t_from_form_without_remote(parse_form(), site(), type_table()) -> + {erl_type(), cache()}. + +t_from_form_without_remote(Form, Site, TypeTable) -> + Module = site_module(Site), + RecDict = dict:from_list([{Module, TypeTable}]), + ExpTypes = replace_by_none, + VarTab = var_table__new(), + Cache = cache__new(), + t_from_form1(Form, ExpTypes, Site, RecDict, VarTab, Cache). + +%% REC_TYPE_LIMIT is used for limiting the depth of recursive types. +%% EXPAND_LIMIT is used for limiting the size of types by +%% limiting the number of elements of lists within one type form. +%% EXPAND_DEPTH is used in conjunction with EXPAND_LIMIT to make the +%% types balanced (unions will otherwise collapse to any()) by limiting +%% the depth the same way as t_limit/2 does. + +-type expand_limit() :: integer(). + +-type expand_depth() :: integer(). + +-record(from_form, {site :: site(), + xtypes :: sets:set(mfa()) | 'replace_by_none', + mrecs :: mod_records(), + vtab :: var_table(), + tnames :: type_names()}). + +-spec t_from_form1(parse_form(), sets:set(mfa()) | 'replace_by_none', + site(), mod_records(), var_table(), cache()) -> + {erl_type(), cache()}. + +t_from_form1(Form, ET, Site, MR, V, C) -> + TypeNames = initial_typenames(Site), + State = #from_form{site = Site, + xtypes = ET, + mrecs = MR, + vtab = V, + tnames = TypeNames}, + L = ?EXPAND_LIMIT, + {T1, L1, C1} = from_form(Form, State, ?EXPAND_DEPTH, L, C), + if + L1 =< 0 -> + from_form_loop(Form, State, 1, L, C1); + true -> + {T1, C1} + end. --type type_names() :: [{'type' | 'opaque' | 'record', atom()}]. --spec t_from_form(parse_form(), type_names(), boolean(), dict(), dict()) -> - {erl_type(), type_names()}. +initial_typenames({type, _MTA}=Site) -> [Site]; +initial_typenames({spec, _MFA}) -> []; +initial_typenames({record, _MRA}) -> []. + +from_form_loop(Form, State, D, Limit, C) -> + {T1, L1, C1} = from_form(Form, State, D, Limit, C), + Delta = Limit - L1, + if + %% Save some time by assuming next depth will exceed the limit. + Delta * 8 > Limit -> + {T1, C1}; + true -> + D1 = D + 1, + from_form_loop(Form, State, D1, Limit, C1) + end. -t_from_form({var, _L, '_'}, _TypeNames, _InOpaque, _RecDict, _VarDict) -> - {t_any(), []}; -t_from_form({var, _L, Name}, _TypeNames, _InOpaque, _RecDict, VarDict) -> - case dict:find(Name, VarDict) of - error -> {t_var(Name), []}; - {ok, Val} -> {Val, []} +-spec from_form(parse_form(), + #from_form{}, + expand_depth(), + expand_limit(), + cache()) -> {erl_type(), expand_limit(), cache()}. + +%% If there is something wrong with parse_form() +%% throw({error, io_lib:chars()} is called; +%% for unknown remote types +%% self() ! {self(), ext_types, {RemMod, Name, ArgsLen}} +%% is called, unless 'replace_by_none' is given. +%% +%% It is assumed that site_module(S) can be found in MR. + +from_form(_, _S, D, L, C) when D =< 0 ; L =< 0 -> + {t_any(), L, C}; +from_form({var, _L, '_'}, _S, _D, L, C) -> + {t_any(), L, C}; +from_form({var, _L, Name}, S, _D, L, C) -> + V = S#from_form.vtab, + case maps:find(Name, V) of + error -> {t_var(Name), L, C}; + {ok, Val} -> {Val, L, C} end; -t_from_form({ann_type, _L, [_Var, Type]}, TypeNames, InOpaque, RecDict, - VarDict) -> - t_from_form(Type, TypeNames, InOpaque, RecDict, VarDict); -t_from_form({paren_type, _L, [Type]}, TypeNames, InOpaque, RecDict, - VarDict) -> - t_from_form(Type, TypeNames, InOpaque, RecDict, VarDict); -t_from_form({remote_type, _L, [{atom, _, Module}, {atom, _, Type}, Args]}, - TypeNames, InOpaque, RecDict, VarDict) -> - {L, R} = list_from_form(Args, TypeNames, InOpaque, RecDict, VarDict), - {t_remote(Module, Type, L), R}; -t_from_form({atom, _L, Atom}, _TypeNames, _InOpaque, _RecDict, _VarDict) -> - {t_atom(Atom), []}; -t_from_form({integer, _L, Int}, _TypeNames, _InOpaque, _RecDict, _VarDict) -> - {t_integer(Int), []}; -t_from_form({op, _L, _Op, _Arg} = Op, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> +from_form({ann_type, _L, [_Var, Type]}, S, D, L, C) -> + from_form(Type, S, D, L, C); +from_form({paren_type, _L, [Type]}, S, D, L, C) -> + from_form(Type, S, D, L, C); +from_form({remote_type, _L, [{atom, _, Module}, {atom, _, Type}, Args]}, + S, D, L, C) -> + remote_from_form(Module, Type, Args, S, D, L, C); +from_form({atom, _L, Atom}, _S, _D, L, C) -> + {t_atom(Atom), L, C}; +from_form({integer, _L, Int}, _S, _D, L, C) -> + {t_integer(Int), L, C}; +from_form({op, _L, _Op, _Arg} = Op, _S, _D, L, C) -> case erl_eval:partial_eval(Op) of {integer, _, Val} -> - {t_integer(Val), []}; + {t_integer(Val), L, C}; _ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Op])}) end; -t_from_form({op, _L, _Op, _Arg1, _Arg2} = Op, _TypeNames, _InOpaque, - _RecDict, _VarDict) -> +from_form({op, _L, _Op, _Arg1, _Arg2} = Op, _S, _D, L, C) -> case erl_eval:partial_eval(Op) of {integer, _, Val} -> - {t_integer(Val), []}; + {t_integer(Val), L, C}; _ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Op])}) end; -t_from_form({type, _L, any, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_any(), []}; -t_from_form({type, _L, arity, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_arity(), []}; -t_from_form({type, _L, array, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_array(), []}; -t_from_form({type, _L, atom, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_atom(), []}; -t_from_form({type, _L, binary, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_binary(), []}; -t_from_form({type, _L, binary, [Base, Unit]} = Type, - _TypeNames, _InOpaque, _RecDict, _VarDict) -> +from_form({type, _L, any, []}, _S, _D, L, C) -> + {t_any(), L, C}; +from_form({type, _L, arity, []}, _S, _D, L, C) -> + {t_arity(), L, C}; +from_form({type, _L, atom, []}, _S, _D, L, C) -> + {t_atom(), L, C}; +from_form({type, _L, binary, []}, _S, _D, L, C) -> + {t_binary(), L, C}; +from_form({type, _L, binary, [Base, Unit]} = Type, _S, _D, L, C) -> case {erl_eval:partial_eval(Base), erl_eval:partial_eval(Unit)} of {{integer, _, B}, {integer, _, U}} when B >= 0, U >= 0 -> - {t_bitstr(U, B), []}; + {t_bitstr(U, B), L, C}; _ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Type])}) end; -t_from_form({type, _L, bitstring, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_bitstr(), []}; -t_from_form({type, _L, bool, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_boolean(), []}; % XXX: Temporarily -t_from_form({type, _L, boolean, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_boolean(), []}; -t_from_form({type, _L, byte, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_byte(), []}; -t_from_form({type, _L, char, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_char(), []}; -t_from_form({type, _L, dict, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_dict(), []}; -t_from_form({type, _L, digraph, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_digraph(), []}; -t_from_form({type, _L, float, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_float(), []}; -t_from_form({type, _L, function, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_fun(), []}; -t_from_form({type, _L, 'fun', []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_fun(), []}; -t_from_form({type, _L, 'fun', [{type, _, any}, Range]}, TypeNames, - InOpaque, RecDict, VarDict) -> - {T, R} = t_from_form(Range, TypeNames, InOpaque, RecDict, VarDict), - {t_fun(T), R}; -t_from_form({type, _L, 'fun', [{type, _, product, Domain}, Range]}, - TypeNames, InOpaque, RecDict, VarDict) -> - {L, R1} = list_from_form(Domain, TypeNames, InOpaque, RecDict, VarDict), - {T, R2} = t_from_form(Range, TypeNames, InOpaque, RecDict, VarDict), - {t_fun(L, T), R1 ++ R2}; -t_from_form({type, _L, gb_set, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_gb_set(), []}; -t_from_form({type, _L, gb_tree, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_gb_tree(), []}; -t_from_form({type, _L, identifier, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_identifier(), []}; -t_from_form({type, _L, integer, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_integer(), []}; -t_from_form({type, _L, iodata, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_iodata(), []}; -t_from_form({type, _L, iolist, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_iolist(), []}; -t_from_form({type, _L, list, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_list(), []}; -t_from_form({type, _L, list, [Type]}, TypeNames, InOpaque, RecDict, - VarDict) -> - {T, R} = t_from_form(Type, TypeNames, InOpaque, RecDict, VarDict), - {t_list(T), R}; -t_from_form({type, _L, mfa, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_mfa(), []}; -t_from_form({type, _L, module, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_module(), []}; -t_from_form({type, _L, nil, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_nil(), []}; -t_from_form({type, _L, neg_integer, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_neg_integer(), []}; -t_from_form({type, _L, non_neg_integer, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_non_neg_integer(), []}; -t_from_form({type, _L, no_return, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_unit(), []}; -t_from_form({type, _L, node, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_node(), []}; -t_from_form({type, _L, none, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_none(), []}; -t_from_form({type, _L, nonempty_list, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_nonempty_list(), []}; -t_from_form({type, _L, nonempty_list, [Type]}, TypeNames, InOpaque, RecDict, - VarDict) -> - {T, R} = t_from_form(Type, TypeNames, InOpaque, RecDict, VarDict), - {t_nonempty_list(T), R}; -t_from_form({type, _L, nonempty_improper_list, [Cont, Term]}, TypeNames, - InOpaque, RecDict, VarDict) -> - {T1, R1} = t_from_form(Cont, TypeNames, InOpaque, RecDict, VarDict), - {T2, R2} = t_from_form(Term, TypeNames, InOpaque, RecDict, VarDict), - {t_cons(T1, T2), R1 ++ R2}; -t_from_form({type, _L, nonempty_maybe_improper_list, []}, _TypeNames, - _InOpaque, _RecDict, _VarDict) -> - {t_cons(?any, ?any), []}; -t_from_form({type, _L, nonempty_maybe_improper_list, [Cont, Term]}, - TypeNames, InOpaque, RecDict, VarDict) -> - {T1, R1} = t_from_form(Cont, TypeNames, InOpaque, RecDict, VarDict), - {T2, R2} = t_from_form(Term, TypeNames, InOpaque, RecDict, VarDict), - {t_cons(T1, T2), R1 ++ R2}; -t_from_form({type, _L, nonempty_string, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_nonempty_string(), []}; -t_from_form({type, _L, number, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_number(), []}; -t_from_form({type, _L, pid, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_pid(), []}; -t_from_form({type, _L, port, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_port(), []}; -t_from_form({type, _L, pos_integer, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_pos_integer(), []}; -t_from_form({type, _L, maybe_improper_list, []}, _TypeNames, _InOpaque, - _RecDict, _VarDict) -> - {t_maybe_improper_list(), []}; -t_from_form({type, _L, maybe_improper_list, [Content, Termination]}, - TypeNames, InOpaque, RecDict, VarDict) -> - {T1, R1} = t_from_form(Content, TypeNames, InOpaque, RecDict, VarDict), - {T2, R2} = t_from_form(Termination, TypeNames, InOpaque, RecDict, VarDict), - {t_maybe_improper_list(T1, T2), R1 ++ R2}; -t_from_form({type, _L, product, Elements}, TypeNames, InOpaque, RecDict, - VarDict) -> - {L, R} = list_from_form(Elements, TypeNames, InOpaque, RecDict, VarDict), - {t_product(L), R}; -t_from_form({type, _L, queue, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_queue(), []}; -t_from_form({type, _L, range, [From, To]} = Type, - _TypeNames, _InOpaque, _RecDict, _VarDict) -> +from_form({type, _L, bitstring, []}, _S, _D, L, C) -> + {t_bitstr(), L, C}; +from_form({type, _L, bool, []}, _S, _D, L, C) -> + {t_boolean(), L, C}; % XXX: Temporarily +from_form({type, _L, boolean, []}, _S, _D, L, C) -> + {t_boolean(), L, C}; +from_form({type, _L, byte, []}, _S, _D, L, C) -> + {t_byte(), L, C}; +from_form({type, _L, char, []}, _S, _D, L, C) -> + {t_char(), L, C}; +from_form({type, _L, float, []}, _S, _D, L, C) -> + {t_float(), L, C}; +from_form({type, _L, function, []}, _S, _D, L, C) -> + {t_fun(), L, C}; +from_form({type, _L, 'fun', []}, _S, _D, L, C) -> + {t_fun(), L, C}; +from_form({type, _L, 'fun', [{type, _, any}, Range]}, S, D, L, C) -> + {T, L1, C1} = from_form(Range, S, D - 1, L - 1, C), + {t_fun(T), L1, C1}; +from_form({type, _L, 'fun', [{type, _, product, Domain}, Range]}, + S, D, L, C) -> + {Dom1, L1, C1} = list_from_form(Domain, S, D, L, C), + {Ran1, L2, C2} = from_form(Range, S, D, L1, C1), + {t_fun(Dom1, Ran1), L2, C2}; +from_form({type, _L, identifier, []}, _S, _D, L, C) -> + {t_identifier(), L, C}; +from_form({type, _L, integer, []}, _S, _D, L, C) -> + {t_integer(), L, C}; +from_form({type, _L, iodata, []}, _S, _D, L, C) -> + {t_iodata(), L, C}; +from_form({type, _L, iolist, []}, _S, _D, L, C) -> + {t_iolist(), L, C}; +from_form({type, _L, list, []}, _S, _D, L, C) -> + {t_list(), L, C}; +from_form({type, _L, list, [Type]}, S, D, L, C) -> + {T, L1, C1} = from_form(Type, S, D - 1, L - 1, C), + {t_list(T), L1, C1}; +from_form({type, _L, map, any}, S, D, L, C) -> + builtin_type(map, t_map(), S, D, L, C); +from_form({type, _L, map, List}, S, D0, L, C) -> + {Pairs1, L5, C5} = + fun PairsFromForm(_, L1, C1) when L1 =< 0 -> {[{?any,?opt,?any}], L1, C1}; + PairsFromForm([], L1, C1) -> {[], L1, C1}; + PairsFromForm([{type, _, Oper, [KF, VF]}|T], L1, C1) -> + D = D0 - 1, + {Key, L2, C2} = from_form(KF, S, D, L1, C1), + {Val, L3, C3} = from_form(VF, S, D, L2, C2), + {Pairs0, L4, C4} = PairsFromForm(T, L3 - 1, C3), + case Oper of + map_field_assoc -> {[{Key,?opt, Val}|Pairs0], L4, C4}; + map_field_exact -> {[{Key,?mand,Val}|Pairs0], L4, C4} + end + end(List, L, C), + try + {Pairs, DefK, DefV} = map_from_form(Pairs1, [], [], [], ?none, ?none), + {t_map(Pairs, DefK, DefV), L5, C5} + catch none -> {t_none(), L5, C5} + end; +from_form({type, _L, mfa, []}, _S, _D, L, C) -> + {t_mfa(), L, C}; +from_form({type, _L, module, []}, _S, _D, L, C) -> + {t_module(), L, C}; +from_form({type, _L, nil, []}, _S, _D, L, C) -> + {t_nil(), L, C}; +from_form({type, _L, neg_integer, []}, _S, _D, L, C) -> + {t_neg_integer(), L, C}; +from_form({type, _L, non_neg_integer, []}, _S, _D, L, C) -> + {t_non_neg_integer(), L, C}; +from_form({type, _L, no_return, []}, _S, _D, L, C) -> + {t_unit(), L, C}; +from_form({type, _L, node, []}, _S, _D, L, C) -> + {t_node(), L, C}; +from_form({type, _L, none, []}, _S, _D, L, C) -> + {t_none(), L, C}; +from_form({type, _L, nonempty_list, []}, _S, _D, L, C) -> + {t_nonempty_list(), L, C}; +from_form({type, _L, nonempty_list, [Type]}, S, D, L, C) -> + {T, L1, C1} = from_form(Type, S, D, L - 1, C), + {t_nonempty_list(T), L1, C1}; +from_form({type, _L, nonempty_improper_list, [Cont, Term]}, S, D, L, C) -> + {T1, L1, C1} = from_form(Cont, S, D, L - 1, C), + {T2, L2, C2} = from_form(Term, S, D, L1, C1), + {t_cons(T1, T2), L2, C2}; +from_form({type, _L, nonempty_maybe_improper_list, []}, _S, _D, L, C) -> + {t_cons(?any, ?any), L, C}; +from_form({type, _L, nonempty_maybe_improper_list, [Cont, Term]}, + S, D, L, C) -> + {T1, L1, C1} = from_form(Cont, S, D, L - 1, C), + {T2, L2, C2} = from_form(Term, S, D, L1, C1), + {t_cons(T1, T2), L2, C2}; +from_form({type, _L, nonempty_string, []}, _S, _D, L, C) -> + {t_nonempty_string(), L, C}; +from_form({type, _L, number, []}, _S, _D, L, C) -> + {t_number(), L, C}; +from_form({type, _L, pid, []}, _S, _D, L, C) -> + {t_pid(), L, C}; +from_form({type, _L, port, []}, _S, _D, L, C) -> + {t_port(), L, C}; +from_form({type, _L, pos_integer, []}, _S, _D, L, C) -> + {t_pos_integer(), L, C}; +from_form({type, _L, maybe_improper_list, []}, _S, _D, L, C) -> + {t_maybe_improper_list(), L, C}; +from_form({type, _L, maybe_improper_list, [Content, Termination]}, + S, D, L, C) -> + {T1, L1, C1} = from_form(Content, S, D, L - 1, C), + {T2, L2, C2} = from_form(Termination, S, D, L1, C1), + {t_maybe_improper_list(T1, T2), L2, C2}; +from_form({type, _L, product, Elements}, S, D, L, C) -> + {Lst, L1, C1} = list_from_form(Elements, S, D - 1, L, C), + {t_product(Lst), L1, C1}; +from_form({type, _L, range, [From, To]} = Type, _S, _D, L, C) -> case {erl_eval:partial_eval(From), erl_eval:partial_eval(To)} of {{integer, _, FromVal}, {integer, _, ToVal}} -> - {t_from_range(FromVal, ToVal), []}; + {t_from_range(FromVal, ToVal), L, C}; _ -> throw({error, io_lib:format("Unable to evaluate type ~w\n", [Type])}) end; -t_from_form({type, _L, record, [Name|Fields]}, TypeNames, InOpaque, RecDict, - VarDict) -> - record_from_form(Name, Fields, TypeNames, InOpaque, RecDict, VarDict); -t_from_form({type, _L, reference, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_reference(), []}; -t_from_form({type, _L, set, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_set(), []}; -t_from_form({type, _L, string, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_string(), []}; -t_from_form({type, _L, term, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_any(), []}; -t_from_form({type, _L, tid, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_tid(), []}; -t_from_form({type, _L, timeout, []}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_timeout(), []}; -t_from_form({type, _L, tuple, any}, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {t_tuple(), []}; -t_from_form({type, _L, tuple, Args}, TypeNames, InOpaque, RecDict, VarDict) -> - {L, R} = list_from_form(Args, TypeNames, InOpaque, RecDict, VarDict), - {t_tuple(L), R}; -t_from_form({type, _L, union, Args}, TypeNames, InOpaque, RecDict, VarDict) -> - {L, R} = list_from_form(Args, TypeNames, InOpaque, RecDict, VarDict), - {t_sup(L), R}; -t_from_form({type, _L, Name, Args}, TypeNames, InOpaque, RecDict, VarDict) -> +from_form({type, _L, record, [Name|Fields]}, S, D, L, C) -> + record_from_form(Name, Fields, S, D, L, C); +from_form({type, _L, reference, []}, _S, _D, L, C) -> + {t_reference(), L, C}; +from_form({type, _L, string, []}, _S, _D, L, C) -> + {t_string(), L, C}; +from_form({type, _L, term, []}, _S, _D, L, C) -> + {t_any(), L, C}; +from_form({type, _L, timeout, []}, _S, _D, L, C) -> + {t_timeout(), L, C}; +from_form({type, _L, tuple, any}, _S, _D, L, C) -> + {t_tuple(), L, C}; +from_form({type, _L, tuple, Args}, S, D, L, C) -> + {Lst, L1, C1} = list_from_form(Args, S, D - 1, L, C), + {t_tuple(Lst), L1, C1}; +from_form({type, _L, union, Args}, S, D, L, C) -> + {Lst, L1, C1} = list_from_form(Args, S, D, L, C), + {t_sup(Lst), L1, C1}; +from_form({user_type, _L, Name, Args}, S, D, L, C) -> + type_from_form(Name, Args, S, D, L, C); +from_form({type, _L, Name, Args}, S, D, L, C) -> + %% Compatibility: modules compiled before Erlang/OTP 18.0. + type_from_form(Name, Args, S, D, L, C); +from_form({opaque, _L, Name, {Mod, Args, Rep}}, _S, _D, L, C) -> + %% XXX. To be removed. + {t_opaque(Mod, Name, Args, Rep), L, C}. + +builtin_type(Name, Type, S, D, L, C) -> + #from_form{site = Site, mrecs = MR} = S, + M = site_module(Site), + case dict:find(M, MR) of + {ok, R} -> + case lookup_type(Name, 0, R) of + {_, {{_M, _FL, _F, _A}, _T}} -> + type_from_form(Name, [], S, D, L, C); + error -> + {Type, L, C} + end; + error -> + {Type, L, C} + end. + +type_from_form(Name, Args, S, D, L, C) -> + #from_form{site = Site, mrecs = MR, tnames = TypeNames} = S, ArgsLen = length(Args), - case lookup_type(Name, ArgsLen, RecDict) of - {type, {_Module, Type, ArgNames}} -> - case can_unfold_more({type, Name}, TypeNames) of - true -> - List = lists:zipwith( - fun(ArgName, ArgType) -> - {Ttemp, _R} = t_from_form(ArgType, TypeNames, - InOpaque, RecDict, - VarDict), - {ArgName, Ttemp} - end, - ArgNames, Args), - TmpVarDict = dict:from_list(List), - {T, R} = t_from_form(Type, [{type, Name}|TypeNames], InOpaque, - RecDict, TmpVarDict), - case lists:member({type, Name}, R) of - true -> {t_limit(T, ?REC_TYPE_LIMIT), R}; - false -> {T, R} - end; - false -> {t_any(), [{type, Name}]} + Module = site_module(Site), + TypeName = {type, {Module, Name, ArgsLen}}, + case can_unfold_more(TypeName, TypeNames) of + true -> + {ok, R} = dict:find(Module, MR), + type_from_form1(Name, Args, ArgsLen, R, TypeName, TypeNames, + S, D, L, C); + false -> + {t_any(), L, C} + end. + +type_from_form1(Name, Args, ArgsLen, R, TypeName, TypeNames, S, D, L, C) -> + case lookup_type(Name, ArgsLen, R) of + {Tag, {{Module, _FileName, Form, ArgNames}, Type}} -> + NewTypeNames = [TypeName|TypeNames], + S1 = S#from_form{tnames = NewTypeNames}, + {ArgTypes, L1, C1} = list_from_form(Args, S1, D, L, C), + CKey = cache_key(Module, Name, ArgTypes, TypeNames, D), + case cache_find(CKey, C) of + {CachedType, DeltaL} -> + {CachedType, L1 - DeltaL, C}; + error -> + List = lists:zip(ArgNames, ArgTypes), + TmpV = maps:from_list(List), + S2 = S1#from_form{site = TypeName, vtab = TmpV}, + Fun = fun(DD, LL) -> from_form(Form, S2, DD, LL, C1) end, + {NewType, L3, C3} = + case Tag of + type -> + recur_limit(Fun, D, L1, TypeName, TypeNames); + opaque -> + {Rep, L2, C2} = recur_limit(Fun, D, L1, TypeName, TypeNames), + Rep1 = choose_opaque_type(Rep, Type), + Rep2 = case cannot_have_opaque(Rep1, TypeName, TypeNames) of + true -> Rep1; + false -> + ArgTypes2 = subst_all_vars_to_any_list(ArgTypes), + t_opaque(Module, Name, ArgTypes2, Rep1) + end, + {Rep2, L2, C2} + end, + C4 = cache_put(CKey, NewType, L1 - L3, C3), + {NewType, L3, C4} end; - {opaque, {Module, Type, ArgNames}} -> - {Rep, Rret} = - case can_unfold_more({opaque, Name}, TypeNames) of - true -> - List = lists:zipwith( - fun(ArgName, ArgType) -> - {Ttemp, _R} = t_from_form(ArgType, TypeNames, - InOpaque, RecDict, - VarDict), - {ArgName, Ttemp} - end, - ArgNames, Args), - TmpVarDict = dict:from_list(List), - {T, R} = t_from_form(Type, [{opaque, Name}|TypeNames], true, - RecDict, TmpVarDict), - case lists:member({opaque, Name}, R) of - true -> {t_limit(T, ?REC_TYPE_LIMIT), R}; - false -> {T, R} - end; - false -> {t_any(), [{opaque, Name}]} - end, - Tret = - case InOpaque of - true -> Rep; - false -> - t_from_form({opaque, -1, Name, {Module, Args, Rep}}, - RecDict, VarDict) - end, - {Tret, Rret}; error -> - Msg = io_lib:format("Unable to find type ~w/~w\n", [Name, ArgsLen]), + Msg = io_lib:format("Unable to find type ~w/~w\n", + [Name, ArgsLen]), throw({error, Msg}) - end; -t_from_form({opaque, _L, Name, {Mod, Args, Rep}}, _TypeNames, _InOpaque, - _RecDict, _VarDict) -> - case Args of - [] -> {t_opaque(Mod, Name, Args, Rep), []}; - _ -> throw({error, "Polymorphic opaque types not supported yet"}) end. -record_from_form({atom, _, Name}, ModFields, TypeNames, InOpaque, RecDict, - VarDict) -> - case can_unfold_more({record, Name}, TypeNames) of +remote_from_form(RemMod, Name, Args, S, D, L, C) -> + #from_form{xtypes = ET, mrecs = MR, tnames = TypeNames} = S, + if + ET =:= replace_by_none -> + {t_none(), L, C}; true -> - case lookup_record(Name, RecDict) of - {ok, DeclFields} -> - TypeNames1 = [{record, Name}|TypeNames], - AreTyped = [is_erl_type(FieldType) - || {_FieldName, FieldType} <- DeclFields], - {DeclFields1, R1} = - case lists:all(fun(Elem) -> Elem end, AreTyped) of - true -> {DeclFields, []}; - false -> fields_from_form(DeclFields, TypeNames1, InOpaque, - RecDict, dict:new()) + ArgsLen = length(Args), + MFA = {RemMod, Name, ArgsLen}, + case dict:find(RemMod, MR) of + error -> + self() ! {self(), ext_types, MFA}, + {t_any(), L, C}; + {ok, RemDict} -> + case sets:is_element(MFA, ET) of + true -> + RemType = {type, MFA}, + case can_unfold_more(RemType, TypeNames) of + true -> + remote_from_form1(RemMod, Name, Args, ArgsLen, RemDict, + RemType, TypeNames, S, D, L, C); + false -> + {t_any(), L, C} + end; + false -> + self() ! {self(), ext_types, {RemMod, Name, ArgsLen}}, + {t_any(), L, C} + end + end + end. + +remote_from_form1(RemMod, Name, Args, ArgsLen, RemDict, RemType, TypeNames, + S, D, L, C) -> + case lookup_type(Name, ArgsLen, RemDict) of + {Tag, {{Mod, _FileLine, Form, ArgNames}, Type}} -> + NewTypeNames = [RemType|TypeNames], + S1 = S#from_form{tnames = NewTypeNames}, + {ArgTypes, L1, C1} = list_from_form(Args, S1, D, L, C), + CKey = cache_key(RemMod, Name, ArgTypes, TypeNames, D), + %% case error of + case cache_find(CKey, C) of + {CachedType, DeltaL} -> + {CachedType, L - DeltaL, C}; + error -> + List = lists:zip(ArgNames, ArgTypes), + TmpVarTab = maps:from_list(List), + S2 = S1#from_form{site = RemType, vtab = TmpVarTab}, + Fun = fun(DD, LL) -> from_form(Form, S2, DD, LL, C1) end, + {NewType, L3, C3} = + case Tag of + type -> + recur_limit(Fun, D, L1, RemType, TypeNames); + opaque -> + {NewRep, L2, C2} = recur_limit(Fun, D, L1, RemType, TypeNames), + NewRep1 = choose_opaque_type(NewRep, Type), + NewRep2 = + case cannot_have_opaque(NewRep1, RemType, TypeNames) of + true -> NewRep1; + false -> + ArgTypes2 = subst_all_vars_to_any_list(ArgTypes), + t_opaque(Mod, Name, ArgTypes2, NewRep1) + end, + {NewRep2, L2, C2} end, - {GetModRec, R2} = get_mod_record(ModFields, DeclFields1, - TypeNames1, InOpaque, - RecDict, VarDict), - case GetModRec of - {error, FieldName} -> - throw({error, io_lib:format("Illegal declaration of #~w{~w}\n", - [Name, FieldName])}); - {ok, NewFields} -> - {t_tuple( - [t_atom(Name)|[Type || {_FieldName, Type} <- NewFields]]), - R1 ++ R2} - end; + C4 = cache_put(CKey, NewType, L1 - L3, C3), + {NewType, L3, C4} + end; + error -> + Msg = io_lib:format("Unable to find remote type ~w:~w()\n", + [RemMod, Name]), + throw({error, Msg}) + end. + +subst_all_vars_to_any_list(Types) -> + [subst_all_vars_to_any(Type) || Type <- Types]. + +%% Opaque types (both local and remote) are problematic when it comes +%% to the limits (TypeNames, D, and L). The reason is that if any() is +%% substituted for a more specialized subtype of an opaque type, the +%% property stated along with decorate_with_opaque() (the type has to +%% be a subtype of the declared type) no longer holds. +%% +%% The less than perfect remedy: if the opaque type created from a +%% form is not a subset of the declared type, the declared type is +%% used instead, effectively bypassing the limits, and potentially +%% resulting in huge types. +choose_opaque_type(Type, DeclType) -> + case + t_is_subtype(subst_all_vars_to_any(Type), + subst_all_vars_to_any(DeclType)) + of + true -> Type; + false -> DeclType + end. + +record_from_form({atom, _, Name}, ModFields, S, D0, L0, C) -> + #from_form{site = Site, mrecs = MR, tnames = TypeNames} = S, + RecordType = {record, Name}, + case can_unfold_more(RecordType, TypeNames) of + true -> + M = site_module(Site), + {ok, R} = dict:find(M, MR), + case lookup_record(Name, R) of + {ok, DeclFields} -> + NewTypeNames = [RecordType|TypeNames], + Site1 = {record, {M, Name, length(DeclFields)}}, + S1 = S#from_form{site = Site1, tnames = NewTypeNames}, + Fun = fun(D, L) -> + {GetModRec, L1, C1} = + get_mod_record(ModFields, DeclFields, S1, D, L, C), + case GetModRec of + {error, FieldName} -> + throw({error, + io_lib:format("Illegal declaration of #~w{~w}\n", + [Name, FieldName])}); + {ok, NewFields} -> + S2 = S1#from_form{vtab = var_table__new()}, + {NewFields1, L2, C2} = + fields_from_form(NewFields, S2, D, L1, C1), + Rec = t_tuple( + [t_atom(Name)|[Type + || {_FieldName, Type} <- NewFields1]]), + {Rec, L2, C2} + end + end, + recur_limit(Fun, D0, L0, RecordType, TypeNames); error -> throw({error, io_lib:format("Unknown record #~w{}\n", [Name])}) end; - false -> {t_any(), []} + false -> + {t_any(), L0, C} end. -get_mod_record([], DeclFields, _TypeNames, _InOpaque, _RecDict, - _VarDict) -> - {{ok, DeclFields}, []}; -get_mod_record(ModFields, DeclFields, TypeNames, InOpaque, RecDict, - VarDict) -> - DeclFieldsDict = orddict:from_list(DeclFields), - {ModFieldsDict, R} = build_field_dict(ModFields, TypeNames, InOpaque, - RecDict, VarDict), - case get_mod_record(DeclFieldsDict, ModFieldsDict, []) of - {error, _FieldName} = Error -> {Error, R}; - {ok, FinalOrdDict} -> - {{ok, [{FieldName, orddict:fetch(FieldName, FinalOrdDict)} - || {FieldName, _} <- DeclFields]}, - R} +get_mod_record([], DeclFields, _S, _D, L, C) -> + {{ok, DeclFields}, L, C}; +get_mod_record(ModFields, DeclFields, S, D, L, C) -> + DeclFieldsDict = lists:keysort(1, DeclFields), + {ModFieldsDict, L1, C1} = build_field_dict(ModFields, S, D, L, C), + case get_mod_record_types(DeclFieldsDict, ModFieldsDict, []) of + {error, _FieldName} = Error -> {Error, L1, C1}; + {ok, FinalKeyDict} -> + Fields = [lists:keyfind(FieldName, 1, FinalKeyDict) + || {FieldName, _, _} <- DeclFields], + {{ok, Fields}, L1, C1} end. -build_field_dict(FieldTypes, TypeNames, InOpaque, RecDict, VarDict) -> - build_field_dict(FieldTypes, TypeNames, InOpaque, RecDict, VarDict, []). - -build_field_dict([{type, _, field_type, [{atom, _, Name}, Type]}|Left], - TypeNames, InOpaque, RecDict, VarDict, Acc) -> - {T, R1} = t_from_form(Type, TypeNames, InOpaque, RecDict, VarDict), - NewAcc = [{Name, T}|Acc], - {D, R2} = build_field_dict(Left, TypeNames, InOpaque, RecDict, VarDict, - NewAcc), - {D, R1 ++ R2}; -build_field_dict([], _TypeNames, _InOpaque, _RecDict, _VarDict, Acc) -> - {orddict:from_list(Acc), []}. - -get_mod_record([{FieldName, DeclType}|Left1], - [{FieldName, ModType}|Left2], Acc) -> - case t_is_var(ModType) orelse t_is_remote(ModType) orelse - t_is_subtype(ModType, DeclType) of - false -> {error, FieldName}; - true -> get_mod_record(Left1, Left2, [{FieldName, ModType}|Acc]) - end; -get_mod_record([{FieldName1, _DeclType} = DT|Left1], - [{FieldName2, _ModType}|_] = List2, - Acc) when FieldName1 < FieldName2 -> - get_mod_record(Left1, List2, [DT|Acc]); -get_mod_record(DeclFields, [], Acc) -> - {ok, orddict:from_list(Acc ++ DeclFields)}; -get_mod_record(_, [{FieldName2, _ModType}|_], _Acc) -> +build_field_dict(FieldTypes, S, D, L, C) -> + build_field_dict(FieldTypes, S, D, L, C, []). + +build_field_dict([{type, _, field_type, [{atom, _, Name}, Type]}|Left], + S, D, L, C, Acc) -> + {T, L1, C1} = from_form(Type, S, D, L - 1, C), + NewAcc = [{Name, Type, T}|Acc], + build_field_dict(Left, S, D, L1, C1, NewAcc); +build_field_dict([], _S, _D, L, C, Acc) -> + {lists:keysort(1, Acc), L, C}. + +get_mod_record_types([{FieldName, _Abstr, _DeclType}|Left1], + [{FieldName, TypeForm, ModType}|Left2], + Acc) -> + get_mod_record_types(Left1, Left2, [{FieldName, TypeForm, ModType}|Acc]); +get_mod_record_types([{FieldName1, _Abstr, _DeclType} = DT|Left1], + [{FieldName2, _FormType, _ModType}|_] = List2, + Acc) when FieldName1 < FieldName2 -> + get_mod_record_types(Left1, List2, [DT|Acc]); +get_mod_record_types(Left1, [], Acc) -> + {ok, lists:keysort(1, Left1++Acc)}; +get_mod_record_types(_, [{FieldName2, _FormType, _ModType}|_], _Acc) -> {error, FieldName2}. -fields_from_form([], _TypeNames, _InOpaque, _RecDict, _VarDict) -> - {[], []}; -fields_from_form([{Name, Type}|Tail], TypeNames, InOpaque, RecDict, - VarDict) -> - {T, R1} = t_from_form(Type, TypeNames, InOpaque, RecDict, VarDict), - {F, R2} = fields_from_form(Tail, TypeNames, InOpaque, RecDict, VarDict), - {[{Name, T}|F], R1 ++ R2}. - -list_from_form([], _TypeNames, _InOpaque, _RecDict, _VarDict) -> - {[], []}; -list_from_form([H|Tail], TypeNames, InOpaque, RecDict, VarDict) -> - {T, R1} = t_from_form(H, TypeNames, InOpaque, RecDict, VarDict), - {L, R2} = list_from_form(Tail, TypeNames, InOpaque, RecDict, VarDict), - {[T|L], R1 ++ R2}. +%% It is important to create a limited version of the record type +%% since nested record types can otherwise easily result in huge +%% terms. +fields_from_form([], _S, _D, L, C) -> + {[], L, C}; +fields_from_form([{Name, Abstr, _Type}|Tail], S, D, L, C) -> + {T, L1, C1} = from_form(Abstr, S, D, L, C), + {F, L2, C2} = fields_from_form(Tail, S, D, L1, C1), + {[{Name, T}|F], L2, C2}. + +list_from_form([], _S, _D, L, C) -> + {[], L, C}; +list_from_form([H|Tail], S, D, L, C) -> + {H1, L1, C1} = from_form(H, S, D, L - 1, C), + {T1, L2, C2} = list_from_form(Tail, S, D, L1, C1), + {[H1|T1], L2, C2}. + +%% Sorts, combines non-singleton pairs, and applies precendence and +%% mandatoriness rules. +map_from_form([], ShdwPs, MKs, Pairs, DefK, DefV) -> + verify_possible(MKs, ShdwPs), + {promote_to_mand(MKs, Pairs), DefK, DefV}; +map_from_form([{SKey,MNess,Val}|SPairs], ShdwPs0, MKs0, Pairs0, DefK0, DefV0) -> + Key = lists:foldl(fun({K,_},S)->t_subtract(S,K)end, SKey, ShdwPs0), + ShdwPs = case Key of ?none -> ShdwPs0; _ -> [{Key,Val}|ShdwPs0] end, + MKs = case MNess of ?mand -> [SKey|MKs0]; ?opt -> MKs0 end, + if MNess =:= ?mand, SKey =:= ?none -> throw(none); + true -> ok + end, + {Pairs, DefK, DefV} = + case is_singleton_type(Key) of + true -> + MNess1 = case Val =:= ?none of true -> ?opt; false -> MNess end, + {mapdict_insert({Key,MNess1,Val}, Pairs0), DefK0, DefV0}; + false -> + case Key =:= ?none orelse Val =:= ?none of + true -> {Pairs0, DefK0, DefV0}; + false -> {Pairs0, t_sup(DefK0, Key), t_sup(DefV0, Val)} + end + end, + map_from_form(SPairs, ShdwPs, MKs, Pairs, DefK, DefV). + +%% Verifies that all mandatory keys are possible, throws 'none' otherwise +verify_possible(MKs, ShdwPs) -> + lists:foreach(fun(M) -> verify_possible_1(M, ShdwPs) end, MKs). + +verify_possible_1(M, ShdwPs) -> + case lists:any(fun({K,_}) -> t_inf(M, K) =/= ?none end, ShdwPs) of + true -> ok; + false -> throw(none) + end. + +-spec promote_to_mand([erl_type()], t_map_dict()) -> t_map_dict(). + +promote_to_mand(_, []) -> []; +promote_to_mand(MKs, [E={K,_,V}|T]) -> + [case lists:any(fun(M) -> t_is_equal(K,M) end, MKs) of + true -> {K, ?mand, V}; + false -> E + end|promote_to_mand(MKs, T)]. + +-define(RECUR_EXPAND_LIMIT, 10). +-define(RECUR_EXPAND_DEPTH, 2). + +%% If more of the limited resources is spent on the non-recursive +%% forms, more warnings are found. And the analysis is also a bit +%% faster. +%% +%% Setting REC_TYPE_LIMIT to 1 would work also work well. + +recur_limit(Fun, D, L, _, _) when L =< ?RECUR_EXPAND_DEPTH, + D =< ?RECUR_EXPAND_LIMIT -> + Fun(D, L); +recur_limit(Fun, D, L, TypeName, TypeNames) -> + case is_recursive(TypeName, TypeNames) of + true -> + {T, L1, C1} = Fun(?RECUR_EXPAND_DEPTH, ?RECUR_EXPAND_LIMIT), + {T, L - L1, C1}; + false -> + Fun(D, L) + end. + +-spec t_check_record_fields(parse_form(), sets:set(mfa()), site(), + mod_records(), var_table(), cache()) -> cache(). + +t_check_record_fields(Form, ExpTypes, Site, RecDict, VarTable, Cache) -> + State = #from_form{site = Site, + xtypes = ExpTypes, + mrecs = RecDict, + vtab = VarTable, + tnames = []}, + check_record_fields(Form, State, Cache). + +-spec check_record_fields(parse_form(), #from_form{}, cache()) -> cache(). + +%% If there is something wrong with parse_form() +%% throw({error, io_lib:chars()} is called. + +check_record_fields({var, _L, _}, _S, C) -> C; +check_record_fields({ann_type, _L, [_Var, Type]}, S, C) -> + check_record_fields(Type, S, C); +check_record_fields({paren_type, _L, [Type]}, S, C) -> + check_record_fields(Type, S, C); +check_record_fields({remote_type, _L, [{atom, _, _}, {atom, _, _}, Args]}, + S, C) -> + list_check_record_fields(Args, S, C); +check_record_fields({atom, _L, _}, _S, C) -> C; +check_record_fields({integer, _L, _}, _S, C) -> C; +check_record_fields({op, _L, _Op, _Arg}, _S, C) -> C; +check_record_fields({op, _L, _Op, _Arg1, _Arg2}, _S, C) -> C; +check_record_fields({type, _L, tuple, any}, _S, C) -> C; +check_record_fields({type, _L, map, any}, _S, C) -> C; +check_record_fields({type, _L, binary, [_Base, _Unit]}, _S, C) -> C; +check_record_fields({type, _L, 'fun', [{type, _, any}, Range]}, S, C) -> + check_record_fields(Range, S, C); +check_record_fields({type, _L, range, [_From, _To]}, _S, C) -> C; +check_record_fields({type, _L, record, [Name|Fields]}, S, C) -> + check_record(Name, Fields, S, C); +check_record_fields({type, _L, _, Args}, S, C) -> + list_check_record_fields(Args, S, C); +check_record_fields({user_type, _L, _Name, Args}, S, C) -> + list_check_record_fields(Args, S, C). + +check_record({atom, _, Name}, ModFields, S, C) -> + #from_form{site = Site, mrecs = MR} = S, + M = site_module(Site), + {ok, R} = dict:find(M, MR), + {ok, DeclFields} = lookup_record(Name, R), + case check_fields(Name, ModFields, DeclFields, S, C) of + {error, FieldName} -> + throw({error, io_lib:format("Illegal declaration of #~w{~w}\n", + [Name, FieldName])}); + C1 -> C1 + end. + +check_fields(RecName, [{type, _, field_type, [{atom, _, Name}, Abstr]}|Left], + DeclFields, S, C) -> + #from_form{site = Site0, xtypes = ET, mrecs = MR, vtab = V} = S, + M = site_module(Site0), + Site = {record, {M, RecName, length(DeclFields)}}, + {Type, C1} = t_from_form(Abstr, ET, Site, MR, V, C), + {Name, _, DeclType} = lists:keyfind(Name, 1, DeclFields), + TypeNoVars = subst_all_vars_to_any(Type), + case t_is_subtype(TypeNoVars, DeclType) of + false -> {error, Name}; + true -> check_fields(RecName, Left, DeclFields, S, C1) + end; +check_fields(_RecName, [], _Decl, _S, C) -> + C. + +list_check_record_fields([], _S, C) -> + C; +list_check_record_fields([H|Tail], S, C) -> + C1 = check_record_fields(H, S, C), + list_check_record_fields(Tail, S, C1). + +site_module({_, {Module, _, _}}) -> + Module. + +-spec cache__new() -> cache(). + +cache__new() -> + maps:new(). + +-spec cache_key(module(), atom(), [erl_type()], + type_names(), expand_depth()) -> cache_key(). + +%% If TypeNames is left out from the key, the cache is smaller, and +%% the form-to-type translation is faster. But it would be a shame if, +%% for example, any() is used, where a more complex type should be +%% used. There is also a slight risk of creating unnecessarily big +%% types. + +cache_key(Module, Name, ArgTypes, TypeNames, D) -> + {Module, Name, D, ArgTypes, TypeNames}. + +-spec cache_find(cache_key(), cache()) -> + {erl_type(), expand_limit()} | 'error'. + +cache_find(Key, Cache) -> + case maps:find(Key, Cache) of + {ok, Value} -> + Value; + error -> + error + end. + +-spec cache_put(cache_key(), erl_type(), expand_limit(), cache()) -> cache(). + +cache_put(_Key, _Type, DeltaL, Cache) when DeltaL < 0 -> + %% The type is truncated; do not reuse it. + Cache; +cache_put(Key, Type, DeltaL, Cache) -> + maps:put(Key, {Type, DeltaL}, Cache). + +-spec t_var_names([erl_type()]) -> [atom()]. + +t_var_names([{var, _, Name}|L]) when L =/= '_' -> + [Name|t_var_names(L)]; +t_var_names([]) -> + []. -spec t_form_to_string(parse_form()) -> string(). @@ -3851,10 +5156,10 @@ t_form_to_string({op, _L, _Op, _Arg1, _Arg2} = Op) -> t_form_to_string({ann_type, _L, [Var, Type]}) -> t_form_to_string(Var) ++ "::" ++ t_form_to_string(Type); t_form_to_string({paren_type, _L, [Type]}) -> - io_lib:format("(~s)", [t_form_to_string(Type)]); + flat_format("(~s)", [t_form_to_string(Type)]); t_form_to_string({remote_type, _L, [{atom, _, Mod}, {atom, _, Name}, Args]}) -> ArgString = "(" ++ string:join(t_form_to_string_list(Args), ",") ++ ")", - io_lib:format("~w:~w", [Mod, Name]) ++ ArgString; + flat_format("~w:~w", [Mod, Name]) ++ ArgString; t_form_to_string({type, _L, arity, []}) -> "arity()"; t_form_to_string({type, _L, binary, []}) -> "binary()"; t_form_to_string({type, _L, binary, [Base, Unit]} = Type) -> @@ -3865,9 +5170,9 @@ t_form_to_string({type, _L, binary, [Base, Unit]} = Type) -> {0, 0} -> "<<>>"; {8, 0} -> "binary()"; {1, 0} -> "bitstring()"; - {0, B} -> lists:flatten(io_lib:format("<<_:~w>>", [B])); - {U, 0} -> lists:flatten(io_lib:format("<<_:_*~w>>", [U])); - {U, B} -> lists:flatten(io_lib:format("<<_:~w,_:_*~w>>", [B, U])) + {0, B} -> flat_format("<<_:~w>>", [B]); + {U, 0} -> flat_format("<<_:_*~w>>", [U]); + {U, B} -> flat_format("<<_:~w,_:_*~w>>", [B, U]) end; _ -> io_lib:format("Badly formed bitstr type ~w", [Type]) end; @@ -3882,6 +5187,13 @@ t_form_to_string({type, _L, iodata, []}) -> "iodata()"; t_form_to_string({type, _L, iolist, []}) -> "iolist()"; t_form_to_string({type, _L, list, [Type]}) -> "[" ++ t_form_to_string(Type) ++ "]"; +t_form_to_string({type, _L, map, any}) -> "map()"; +t_form_to_string({type, _L, map, Args}) -> + "#{" ++ string:join(t_form_to_string_list(Args), ",") ++ "}"; +t_form_to_string({type, _L, map_field_assoc, [Key, Val]}) -> + t_form_to_string(Key) ++ "=>" ++ t_form_to_string(Val); +t_form_to_string({type, _L, map_field_exact, [Key, Val]}) -> + t_form_to_string(Key) ++ ":=" ++ t_form_to_string(Val); t_form_to_string({type, _L, mfa, []}) -> "mfa()"; t_form_to_string({type, _L, module, []}) -> "module()"; t_form_to_string({type, _L, node, []}) -> "node()"; @@ -3893,16 +5205,16 @@ t_form_to_string({type, _L, product, Elements}) -> t_form_to_string({type, _L, range, [From, To]} = Type) -> case {erl_eval:partial_eval(From), erl_eval:partial_eval(To)} of {{integer, _, FromVal}, {integer, _, ToVal}} -> - io_lib:format("~w..~w", [FromVal, ToVal]); - _ -> io_lib:format("Badly formed type ~w",[Type]) + flat_format("~w..~w", [FromVal, ToVal]); + _ -> flat_format("Badly formed type ~w",[Type]) end; t_form_to_string({type, _L, record, [{atom, _, Name}]}) -> - io_lib:format("#~w{}", [Name]); + flat_format("#~w{}", [Name]); t_form_to_string({type, _L, record, [{atom, _, Name}|Fields]}) -> FieldString = string:join(t_form_to_string_list(Fields), ","), - io_lib:format("#~w{~s}", [Name, FieldString]); + flat_format("#~w{~s}", [Name, FieldString]); t_form_to_string({type, _L, field_type, [{atom, _, Name}, Type]}) -> - io_lib:format("~w::~s", [Name, t_form_to_string(Type)]); + flat_format("~w::~s", [Name, t_form_to_string(Type)]); t_form_to_string({type, _L, term, []}) -> "term()"; t_form_to_string({type, _L, timeout, []}) -> "timeout()"; t_form_to_string({type, _L, tuple, any}) -> "tuple()"; @@ -3911,12 +5223,28 @@ t_form_to_string({type, _L, tuple, Args}) -> t_form_to_string({type, _L, union, Args}) -> string:join(t_form_to_string_list(Args), " | "); t_form_to_string({type, _L, Name, []} = T) -> - try t_to_string(t_from_form(T)) + try + M = mod, + D0 = dict:new(), + MR = dict:from_list([{M, D0}]), + Site = {type, {M,Name,0}}, + V = var_table__new(), + C = cache__new(), + State = #from_form{site = Site, + xtypes = sets:new(), + mrecs = MR, + vtab = V, + tnames = []}, + {T1, _, _} = from_form(T, State, _Deep=1000, _ALot=1000000, C), + t_to_string(T1) catch throw:{error, _} -> atom_to_string(Name) ++ "()" end; -t_form_to_string({type, _L, Name, List}) -> - io_lib:format("~w(~s)", - [Name, string:join(t_form_to_string_list(List), ",")]). +t_form_to_string({user_type, _L, Name, List}) -> + flat_format("~w(~s)", + [Name, string:join(t_form_to_string_list(List), ",")]); +t_form_to_string({type, L, Name, List}) -> + %% Compatibility: modules compiled before Erlang/OTP 18.0. + t_form_to_string({user_type, L, Name, List}). t_form_to_string_list(List) -> t_form_to_string_list(List, []). @@ -3929,7 +5257,7 @@ t_form_to_string_list([], Acc) -> -spec atom_to_string(atom()) -> string(). atom_to_string(Atom) -> - lists:flatten(io_lib:format("~w", [Atom])). + flat_format("~w", [Atom]). %%============================================================================= %% @@ -3958,14 +5286,14 @@ is_erl_type(?unit) -> true; is_erl_type(#c{}) -> true; is_erl_type(_) -> false. --spec lookup_record(atom(), dict()) -> - 'error' | {'ok', [{atom(), parse_form() | erl_type()}]}. +-spec lookup_record(atom(), type_table()) -> + 'error' | {'ok', [{atom(), parse_form(), erl_type()}]}. lookup_record(Tag, RecDict) when is_atom(Tag) -> case dict:find({record, Tag}, RecDict) of - {ok, [{_Arity, Fields}]} -> + {ok, {_FileLine, [{_Arity, Fields}]}} -> {ok, Fields}; - {ok, List} when is_list(List) -> + {ok, {_FileLine, List}} when is_list(List) -> %% This will have to do, since we do not know which record we %% are looking for. error; @@ -3973,15 +5301,17 @@ lookup_record(Tag, RecDict) when is_atom(Tag) -> error end. --spec lookup_record(atom(), arity(), dict()) -> 'error' | {'ok', [{atom(), erl_type()}]}. +-spec lookup_record(atom(), arity(), type_table()) -> + 'error' | {'ok', [{atom(), parse_form(), erl_type()}]}. lookup_record(Tag, Arity, RecDict) when is_atom(Tag) -> case dict:find({record, Tag}, RecDict) of - {ok, [{Arity, Fields}]} -> {ok, Fields}; - {ok, OrdDict} -> orddict:find(Arity, OrdDict); + {ok, {_FileLine, [{Arity, Fields}]}} -> {ok, Fields}; + {ok, {_FileLine, OrdDict}} -> orddict:find(Arity, OrdDict); error -> error end. +-spec lookup_type(_, _, _) -> {'type' | 'opaque', type_value()} | 'error'. lookup_type(Name, Arity, RecDict) -> case dict:find({type, Name, Arity}, RecDict) of error -> @@ -3992,15 +5322,110 @@ lookup_type(Name, Arity, RecDict) -> {ok, Found} -> {type, Found} end. --spec type_is_defined('type' | 'opaque', atom(), arity(), dict()) -> boolean(). +-spec type_is_defined('type' | 'opaque', atom(), arity(), type_table()) -> + boolean(). type_is_defined(TypeOrOpaque, Name, Arity, RecDict) -> dict:is_key({TypeOrOpaque, Name, Arity}, RecDict). +cannot_have_opaque(Type, TypeName, TypeNames) -> + t_is_none(Type) orelse is_recursive(TypeName, TypeNames). + +is_recursive(TypeName, TypeNames) -> + lists:member(TypeName, TypeNames). + can_unfold_more(TypeName, TypeNames) -> Fun = fun(E, Acc) -> case E of TypeName -> Acc + 1; _ -> Acc end end, lists:foldl(Fun, 0, TypeNames) < ?REC_TYPE_LIMIT. +-spec do_opaque(erl_type(), opaques(), fun((_) -> T)) -> T. + +%% Probably a little faster than calling t_unopaque/2. +%% Unions that are due to opaque types are unopaqued. +do_opaque(?opaque(_) = Type, Opaques, Pred) -> + case Opaques =:= 'universe' orelse is_opaque_type(Type, Opaques) of + true -> do_opaque(t_opaque_structure(Type), Opaques, Pred); + false -> Pred(Type) + end; +do_opaque(?union(List) = Type, Opaques, Pred) -> + [A,B,F,I,L,N,T,M,O,Map] = List, + if O =:= ?none -> Pred(Type); + true -> + case Opaques =:= 'universe' orelse is_opaque_type(O, Opaques) of + true -> + S = t_opaque_structure(O), + do_opaque(t_sup([A,B,F,I,L,N,T,M,S,Map]), Opaques, Pred); + false -> Pred(Type) + end + end; +do_opaque(Type, _Opaques, Pred) -> + Pred(Type). + +map_all_values(?map(Pairs,_,DefV)) -> + [DefV|[V || {V, _, _} <- Pairs]]. + +map_all_keys(?map(Pairs,DefK,_)) -> + [DefK|[K || {_, _, K} <- Pairs]]. + +map_all_types(M) -> + map_all_keys(M) ++ map_all_values(M). + +%% Tests if a type has exactly one possible value. +-spec t_is_singleton(erl_type()) -> boolean(). + +t_is_singleton(Type) -> + t_is_singleton(Type, 'universe'). + +-spec t_is_singleton(erl_type(), opaques()) -> boolean(). + +t_is_singleton(Type, Opaques) -> + do_opaque(Type, Opaques, fun is_singleton_type/1). + +%% Incomplete; not all representable singleton types are included. +is_singleton_type(?nil) -> true; +is_singleton_type(?atom(?any)) -> false; +is_singleton_type(?atom(Set)) -> + ordsets:size(Set) =:= 1; +is_singleton_type(?int_range(V, V)) -> true; +is_singleton_type(?int_set(Set)) -> + ordsets:size(Set) =:= 1; +is_singleton_type(?tuple(Types, Arity, _)) when is_integer(Arity) -> + lists:all(fun is_singleton_type/1, Types); +is_singleton_type(?tuple_set([{Arity, [OnlyTuple]}])) when is_integer(Arity) -> + is_singleton_type(OnlyTuple); +is_singleton_type(?map(Pairs, ?none, ?none)) -> + lists:all(fun({_,MNess,V}) -> MNess =:= ?mand andalso is_singleton_type(V) + end, Pairs); +is_singleton_type(_) -> + false. + +%% Returns the only possible value of a singleton type. +-spec t_singleton_to_term(erl_type(), opaques()) -> term(). + +t_singleton_to_term(Type, Opaques) -> + do_opaque(Type, Opaques, fun singleton_type_to_term/1). + +singleton_type_to_term(?nil) -> []; +singleton_type_to_term(?atom(Set)) when Set =/= ?any -> + case ordsets:size(Set) of + 1 -> hd(ordsets:to_list(Set)); + _ -> error(badarg) + end; +singleton_type_to_term(?int_range(V, V)) -> V; +singleton_type_to_term(?int_set(Set)) -> + case ordsets:size(Set) of + 1 -> hd(ordsets:to_list(Set)); + _ -> error(badarg) + end; +singleton_type_to_term(?tuple(Types, Arity, _)) when is_integer(Arity) -> + lists:map(fun singleton_type_to_term/1, Types); +singleton_type_to_term(?tuple_set([{Arity, [OnlyTuple]}])) + when is_integer(Arity) -> + singleton_type_to_term(OnlyTuple); +singleton_type_to_term(?map(Pairs, ?none, ?none)) -> + maps:from_list([{singleton_type_to_term(K), singleton_type_to_term(V)} + || {K,?mand,V} <- Pairs]). + %% ----------------------------------- %% Set %% @@ -4022,10 +5447,6 @@ set_union(S1, S2) -> _ -> ?any end. -set_union_no_limit(?any, _) -> ?any; -set_union_no_limit(_, ?any) -> ?any; -set_union_no_limit(S1, S2) -> ordsets:union(S1, S2). - %% The intersection and subtraction can return ?none. %% This should always be handled right away since ?none is not a valid set. %% However, ?any is considered a valid set. @@ -4067,7 +5488,7 @@ set_size(Set) -> set_to_string(Set) -> L = [case is_atom(X) of true -> io_lib:write_string(atom_to_list(X), $'); % stupid emacs ' - false -> io_lib:format("~w", [X]) + false -> flat_format("~w", [X]) end || X <- set_to_list(Set)], string:join(L, " | "). @@ -4076,6 +5497,9 @@ set_min([H|_]) -> H. set_max(Set) -> hd(lists:reverse(Set)). +flat_format(F, S) -> + lists:flatten(io_lib:format(F, S)). + %%============================================================================= %% %% Utilities for the binary type @@ -4130,6 +5554,22 @@ handle_base(Unit, Pos) when Pos >= 0 -> handle_base(Unit, Neg) -> (Unit+(Neg rem Unit)) rem Unit. +family(L) -> + R = sofs:relation(L), + F = sofs:relation_to_family(R), + sofs:to_external(F). + +%%============================================================================= +%% +%% Interface functions for abstract data types defined in this module +%% +%%============================================================================= + +-spec var_table__new() -> var_table(). + +var_table__new() -> + maps:new(). + %%============================================================================= %% Consistency-testing function(s) below %%============================================================================= diff --git a/lib/hipe/doc/Makefile b/lib/hipe/doc/Makefile index 4ea0137202..1015ca78eb 100644 --- a/lib/hipe/doc/Makefile +++ b/lib/hipe/doc/Makefile @@ -1,18 +1,19 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2006-2012. All Rights Reserved. +# Copyright Ericsson AB 2006-2016. All Rights Reserved. # -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at # -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. # # %CopyrightEnd% # diff --git a/lib/hipe/doc/src/Makefile b/lib/hipe/doc/src/Makefile index fbfd4ca327..a5edb80381 100644 --- a/lib/hipe/doc/src/Makefile +++ b/lib/hipe/doc/src/Makefile @@ -1,18 +1,19 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2006-2012. All Rights Reserved. +# Copyright Ericsson AB 2006-2016. All Rights Reserved. # -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at # -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. # # %CopyrightEnd% # diff --git a/lib/hipe/doc/src/book.xml b/lib/hipe/doc/src/book.xml index 9c95e3a827..7c594f12ad 100644 --- a/lib/hipe/doc/src/book.xml +++ b/lib/hipe/doc/src/book.xml @@ -1,23 +1,24 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="utf-8" ?> <!DOCTYPE book SYSTEM "book.dtd"> <book xmlns:xi="http://www.w3.org/2001/XInclude"> <header titlestyle="normal"> <copyright> - <year>2006</year><year>2010</year> + <year>2006</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> - The contents of this file are subject to the Erlang Public License, - Version 1.1, (the "License"); you may not use this file except in - compliance with the License. You should have received a copy of the - Erlang Public License along with this software. If not, it can be - retrieved online at http://www.erlang.org/. + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 - Software distributed under the License is distributed on an "AS IS" - basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See - the License for the specific language governing rights and limitations - under the License. + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. </legalnotice> diff --git a/lib/hipe/doc/src/fascicules.xml b/lib/hipe/doc/src/fascicules.xml index 28acc14624..b15610fa8b 100644 --- a/lib/hipe/doc/src/fascicules.xml +++ b/lib/hipe/doc/src/fascicules.xml @@ -1,4 +1,4 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="utf-8" ?> <!DOCTYPE fascicules SYSTEM "fascicules.dtd"> <fascicules> diff --git a/lib/hipe/doc/src/hipe_app.xml b/lib/hipe/doc/src/hipe_app.xml index 0612392c3f..e489d155c3 100644 --- a/lib/hipe/doc/src/hipe_app.xml +++ b/lib/hipe/doc/src/hipe_app.xml @@ -1,23 +1,24 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="utf-8" ?> <!DOCTYPE appref SYSTEM "appref.dtd"> <appref> <header> <copyright> - <year>1997</year><year>2013</year> + <year>1997</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> - The contents of this file are subject to the Erlang Public License, - Version 1.1, (the "License"); you may not use this file except in - compliance with the License. You should have received a copy of the - Erlang Public License along with this software. If not, it can be - retrieved online at http://www.erlang.org/. + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 - Software distributed under the License is distributed on an "AS IS" - basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See - the License for the specific language governing rights and limitations - under the License. + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. </legalnotice> @@ -36,15 +37,14 @@ <description> <p> The normal way to native-compile an Erlang module using HiPE is to include the atom native - in the Erlang compiler options, as in: - <code> - 1> <input>c(my_module, [native]).</input></code> - Options to the HiPE compiler are then passed as follows: - <code> - 1> <input>c(my_module, [native,{hipe,Options}]).</input></code> - For on-line help in the Erlang shell, call <c>hipe:help()</c>. - Details on HiPE compiler options are given by <c>hipe:help_options()</c>. - </p> + in the Erlang compiler options, as in:</p> + <pre> + 1> <input>c(my_module, [native]).</input></pre> + <p>Options to the HiPE compiler are then passed as follows:</p> + <pre> + 1> <input>c(my_module, [native,{hipe,Options}]).</input></pre> + <p>For on-line help in the Erlang shell, call <c>hipe:help()</c>. + Details on HiPE compiler options are given by <c>hipe:help_options()</c>.</p> </description> <section> <title>SEE ALSO</title> diff --git a/lib/hipe/doc/src/notes.xml b/lib/hipe/doc/src/notes.xml index b3c41bd396..e2a1524be6 100644 --- a/lib/hipe/doc/src/notes.xml +++ b/lib/hipe/doc/src/notes.xml @@ -1,23 +1,24 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="utf-8" ?> <!DOCTYPE chapter SYSTEM "chapter.dtd"> <chapter> <header> <copyright> - <year>2006</year><year>2013</year> + <year>2006</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> - The contents of this file are subject to the Erlang Public License, - Version 1.1, (the "License"); you may not use this file except in - compliance with the License. You should have received a copy of the - Erlang Public License along with this software. If not, it can be - retrieved online at http://www.erlang.org/. - - Software distributed under the License is distributed on an "AS IS" - basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See - the License for the specific language governing rights and limitations - under the License. + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. </legalnotice> @@ -30,6 +31,521 @@ </header> <p>This document describes the changes made to HiPE.</p> +<section><title>Hipe 3.15.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + HiPE compiler crashed, during compilation, in some cases + that involved inlining of float operations on complicated + control flow graphs.</p> + <p> + Own Id: OTP-13407 Aux Id: PR-984 </p> + </item> + <item> + <p> + Various fixes and improvements to the HiPE LLVM backend. + <list> <item>Add support for LLVM 3.7 and 3.8 in the + HiPE/LLVM x86_64 backend</item> <item>Reinstate support + for the LLVM backend on x86 (works OK for LLVM 3.5 to 3.7 + -- LLVM 3.8 has a bug that prevents it from generating + correct native code on x86)</item> </list></p> + <p> + Own Id: OTP-13626</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Elimination of <c>maps:is_key/2</c> calls to HiPE</p> + <p> + Own Id: OTP-13625 Aux Id: PR-1069 </p> + </item> + </list> + </section> + +</section> + +<section><title>Hipe 3.15</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix pretty printing of Core Maps</p> + <p> + Literal maps could cause Dialyzer to crash when pretty + printing the results.</p> + <p> + Own Id: OTP-13238</p> + </item> + <item> + <p> + Dialyzer warnings removed.</p> + <p> + Own Id: OTP-13379</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Fix HiPE ErLLVM code generation for pattern matching with + UTF binaries.</p> + <p> + Own Id: OTP-13269</p> + </item> + <item> + <p> + Fix various binary construction inconsistencies for hipe + compiled code. <list> <item>Passing bad field sizes to + binary constructions would throw <c>badarith</c> rather + than <c>badarg</c>. Worse, in guards, when the unit size + of the field was 1, the exception would leak rather than + failing the function clause match.</item> <item>Passing + bignums as field sizes to binary constructions would + always fail (and always with <c>badarg</c>).</item> + <item>A bug in bs_init_bits that cased binary + constructions to fail with system_limit if they were at + least 1/8th of the actual limit.</item> <item>Compiler + crashes when matches against an integer literal whose + size fits an unsigned word, but not a signed word or + matches against an integer literal that whose size is + larger than the largest allowed bignum.</item> <item>Very + large binary constructions that should fail with + system_limit could instead fail with <c>badarg</c> or + even succeed with a faulty result.</item> <item>Add + missing check for unit size match when inserting a + binary. For example, a faulty expression like + <c><<<<1:7>>/binary>></c> would + succeed.</item> </list></p> + <p> + Own Id: OTP-13272</p> + </item> + </list> + </section> + +</section> + +<section><title>Hipe 3.14</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix hipe bug causing segfaults when native code + constructs binaries starting with a zero-length integer + field.</p> + <p> + Own Id: OTP-13048</p> + </item> + <item> + <p> + Reintroduce the <c>erlang:make_fun/3</c> BIF in + erl_bif_types.</p> + <p> + Own Id: OTP-13068</p> + </item> + <item> + <p> + In certain cases of matching with very big binaries, the + HiPE compiler generated code that would fail the match, + even in cases that the matching was successful. The + problem was more quite noticeable on 32-bit platforms.</p> + <p> + Own Id: OTP-13092</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + mikpe/hipe_x86_signal-musl-support</p> + <p> + Own Id: OTP-13159</p> + </item> + </list> + </section> + +</section> + +<section><title>Hipe 3.13</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Fix bugs concerning <c>erlang:abs/1</c>. </p> + <p> + Own Id: OTP-12948</p> + </item> + <item> + <p> Fix a bug concerning <c>lists:keydelete/3</c> with + union and opaque types. </p> + <p> + Own Id: OTP-12949</p> + </item> + <item> + <p> + A beam file compiled by hipe for an incompatible runtime + system was sometimes not rejected by the loader, which + could lead to vm crash. This fix will also allow the same + hipe compiler to be used by both normal and debug-built + vm.</p> + <p> + Own Id: OTP-12962</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + New function <c>hipe:erts_checksum/0</c> which returns a + value identifying the target runtime system for the + compiler. Used by dialyzer for its beam cache directory.</p> + <p> + Own Id: OTP-12963 Aux Id: OTP-12962, OTP-12964 </p> + </item> + </list> + </section> + +</section> + +<section><title>Hipe 3.12</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> Fix a minor bug in the handling of opaque types. </p> + <p> + Own Id: OTP-12666</p> + </item> + <item> + <p> + Fix hipe bug when matching a "writable" binary. The bug + has been seen to sometimes cause a failed binary matching + of a correct utf8 character, but other symptoms are also + possible.</p> + <p> + Own Id: OTP-12667</p> + </item> + <item> + <p> + Optimizations and code cleanup in hipe code loader.</p> + <p> + Own Id: OTP-12816</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Improved error handling when memory allocation for HiPE + code fails.</p> + <p> + Own Id: OTP-12448</p> + </item> + <item> + <p> + Allow use of complete interface of cerl_pmatch module</p> + <p> + Own Id: OTP-12794</p> + </item> + </list> + </section> + +</section> + +<section><title>Hipe 3.11.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix HiPE for ARM when Erlang VM is compiled for Thumb + execution mode. This was a problem on e.g. Ubuntu which + configures its system GCC to generate Thumb by default.</p> + <p> + Own Id: OTP-12405</p> + </item> + <item> + <p> + Reduced lock contention of dynamic function lookups (like + apply) from hipe compiled code.</p> + <p> + Own Id: OTP-12557</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Fix two bugs in HiPE compiler regarding floating-points, + both leading to crash during compilation. The + target-specific code generators failed to handle integer + to floating-point conversion instructions with constant + operands. The middle-end could use an incorrect + representation for copies between floating-point + registers.</p> + <p> + Own Id: OTP-12413</p> + </item> + <item> + <p> + Improved error handling when memory allocation for HiPE + code fails.</p> + <p> + Own Id: OTP-12448</p> + </item> + </list> + </section> + +</section> + +<section><title>Hipe 3.11.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixed internal elf_format hrl file to contain valid + erlang</p> + <p> + Own Id: OTP-12322</p> + </item> + </list> + </section> + +</section> + +<section><title>Hipe 3.11.1</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> The pretty-printing of bitstrings has been corrected. + </p> + <p> + Own Id: OTP-12015</p> + </item> + <item> + <p> A bug concerning <c>is_record/2,3</c> has been fixed, + as well as some cases where Dialyzer could crash due to + reaching system limits. </p> + <p> + Own Id: OTP-12018</p> + </item> + </list> + </section> + +</section> + +<section><title>Hipe 3.11</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + A Dialyzer crash involving analysis of Map types has now + been fixed.</p> + <p> + Own Id: OTP-11947</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + Handle Maps instructions get_map_elements, put_map_assoc, + put_map_exact in HiPE compiler.</p> + <p> + Own Id: OTP-11900</p> + </item> + </list> + </section> + +</section> + +<section><title>Hipe 3.10.3</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fix compilation with 'no_remove_comments' (Thanks to + Johannes Weißl)</p> + <p> + Own Id: OTP-11564</p> + </item> + <item> + <p> + Application upgrade (appup) files are corrected for the + following applications: </p> + <p> + <c>asn1, common_test, compiler, crypto, debugger, + dialyzer, edoc, eldap, erl_docgen, et, eunit, gs, hipe, + inets, observer, odbc, os_mon, otp_mibs, parsetools, + percept, public_key, reltool, runtime_tools, ssh, + syntax_tools, test_server, tools, typer, webtool, wx, + xmerl</c></p> + <p> + A new test utility for testing appup files is added to + test_server. This is now used by most applications in + OTP.</p> + <p> + (Thanks to Tobias Schlager)</p> + <p> + Own Id: OTP-11744</p> + </item> + <item> + <p> + There is now a test suite for the Hipe application</p> + <p> + Own Id: OTP-11748</p> + </item> + <item> + <p> + Support for a LLVM backend has been added in HiPE</p> + <p> + Own Id: OTP-11801</p> + </item> + </list> + </section> + + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> The pre-defined types <c>array/0</c>, <c>dict/0</c>, + <c>digraph/0</c>, <c>gb_set/0</c>, <c>gb_tree/0</c>, + <c>queue/0</c>, <c>set/0</c>, and <c>tid/0</c> have been + deprecated. They will be removed in Erlang/OTP 18.0. </p> + <p> Instead the types <c>array:array/0</c>, + <c>dict:dict/0</c>, <c>digraph:graph/0</c>, + <c>gb_set:set/0</c>, <c>gb_tree:tree/0</c>, + <c>queue:queue/0</c>, <c>sets:set/0</c>, and + <c>ets:tid/0</c> can be used. (Note: it has always been + necessary to use <c>ets:tid/0</c>.) </p> <p> It is + allowed in Erlang/OTP 17.0 to locally re-define the types + <c>array/0</c>, <c>dict/0</c>, and so on. </p> <p> New + types <c>array:array/1</c>, <c>dict:dict/2</c>, + <c>gb_sets:set/1</c>, <c>gb_trees:tree/2</c>, + <c>queue:queue/1</c>, and <c>sets:set/1</c> have been + added. </p> <p> A compiler option, + <c>nowarn_deprecated_type</c>, has been introduced. By + including the attribute </p> <c> + -compile(nowarn_deprecated_type).</c> <p> in an Erlang + source file, warnings about deprecated types can be + avoided in Erlang/OTP 17.0. </p> <p> The option can also + be given as a compiler flag: </p> <c> erlc + +nowarn_deprecated_type file.erl</c> + <p> + Own Id: OTP-10342</p> + </item> + <item> + <p> + EEP43: New data type - Maps</p> + <p> + With Maps you may for instance:</p> + <taglist> + <tag/> <item><c>M0 = #{ a => 1, b => 2}, % create + associations</c></item> + <tag/><item><c>M1 = M0#{ a := 10 }, % update values</c></item> + <tag/><item><c>M2 = M1#{ "hi" => + "hello"}, % add new associations</c></item> + <tag/><item><c>#{ "hi" := V1, a := V2, b := V3} = M2. + % match keys with values</c></item> + </taglist> + <p> + For information on how to use Maps please see Map Expressions in the + <seealso marker="doc/reference_manual:expressions#map_expressions"> + Reference Manual</seealso>.</p> + <p> + The current implementation is without the following + features:</p> + <taglist> + <tag/><item>No variable keys</item> + <tag/><item>No single value access</item> + <tag/><item>No map comprehensions</item> + </taglist> + <p> + Note that Maps is <em>experimental</em> during OTP 17.0.</p> + <p> + Own Id: OTP-11616</p> + </item> + <item> + <p> Parameterized opaque types have been introduced. </p> + <p> + Own Id: OTP-11625</p> + </item> + <item> + <p> + Add support for the compilation of the is_map/1 and + map_size/1 guards to native code.</p> + <p> + Own Id: OTP-11831</p> + </item> + </list> + </section> + +</section> + +<section><title>Hipe 3.10.2.2</title> + + <section><title>Fixed Bugs and Malfunctions</title> + <list> + <item> + <p> + Fixed a dialyzer crash when using remote types in the + tail position of a maybe_improper_list/2 type. Thanks to + Kostis Sagonas</p> + <p> + Own Id: OTP-11374</p> + </item> + </list> + </section> + +</section> + +<section><title>Hipe 3.10.2.1</title> + + <section><title>Improvements and New Features</title> + <list> + <item> + <p> + The encoding of the <c>notes.xml</c> file has been + changed from latin1 to utf-8 to avoid future merge + problems.</p> + <p> + Own Id: OTP-11310</p> + </item> + </list> + </section> + +</section> + <section><title>Hipe 3.10.2</title> <section><title>Improvements and New Features</title> @@ -37,7 +553,7 @@ <item> <p> Fix the title of hipe_app documentation page. Thanks to - Lo�c Hoguin.</p> + Loïc Hoguin.</p> <p> Own Id: OTP-10904</p> </item> @@ -76,7 +592,7 @@ <p> Fix bug in hipe compiled code related to the handling of <c>is_number/1</c>. (Thanks to Sebastian Egner and - Johannes Wei�l for minimal test code and Kostis for quick + Johannes Weißl for minimal test code and Kostis for quick patch)</p> <p> Own Id: OTP-10897</p> @@ -241,19 +757,17 @@ <section><title>Fixed Bugs and Malfunctions</title> <list> <item> - <p> <list> <item><p>No warnings for underspecs with remote types</p></item> <item><p> Fix crash in Typer</p></item> <item><p>Fix Dialyzer's warning for its own code</p></item> <item><p>Fix Dialyzer's warnings in HiPE</p></item> <item><p>Add file/line info in a particular Dialyzer crash</p></item> <item><p>Update - inets test results</p></item> </list></p> + inets test results</p></item> </list> <p> Own Id: OTP-9758</p> </item> <item> - <p> <list> <item><p>Correct callback spec in application module</p></item> <item><p>Refine warning about callback specs with extra ranges</p></item> <item><p>Cleanup @@ -264,7 +778,7 @@ analysis</p></item> <item><p>Fix crash in Dialyzer</p></item> <item><p>Variable substitution was not generalizing any unknown variables.</p></item> - </list></p> + </list> <p> Own Id: OTP-9776</p> </item> diff --git a/lib/hipe/doc/src/part_notes.xml b/lib/hipe/doc/src/part_notes.xml index 8a3e82027b..828c304fb5 100644 --- a/lib/hipe/doc/src/part_notes.xml +++ b/lib/hipe/doc/src/part_notes.xml @@ -1,23 +1,24 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="utf-8" ?> <!DOCTYPE part SYSTEM "part.dtd"> <part xmlns:xi="http://www.w3.org/2001/XInclude"> <header> <copyright> - <year>2006</year><year>2009</year> + <year>2006</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> - The contents of this file are subject to the Erlang Public License, - Version 1.1, (the "License"); you may not use this file except in - compliance with the License. You should have received a copy of the - Erlang Public License along with this software. If not, it can be - retrieved online at http://www.erlang.org/. - - Software distributed under the License is distributed on an "AS IS" - basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See - the License for the specific language governing rights and limitations - under the License. + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. </legalnotice> diff --git a/lib/hipe/doc/src/ref_man.xml b/lib/hipe/doc/src/ref_man.xml index bdafb61d08..7938729227 100644 --- a/lib/hipe/doc/src/ref_man.xml +++ b/lib/hipe/doc/src/ref_man.xml @@ -1,23 +1,24 @@ -<?xml version="1.0" encoding="latin1" ?> +<?xml version="1.0" encoding="utf-8" ?> <!DOCTYPE application SYSTEM "application.dtd"> <application xmlns:xi="http://www.w3.org/2001/XInclude"> <header> <copyright> - <year>1996</year><year>2011</year> + <year>1996</year><year>2016</year> <holder>Ericsson AB. All Rights Reserved.</holder> </copyright> <legalnotice> - The contents of this file are subject to the Erlang Public License, - Version 1.1, (the "License"); you may not use this file except in - compliance with the License. You should have received a copy of the - Erlang Public License along with this software. If not, it can be - retrieved online at http://www.erlang.org/. - - Software distributed under the License is distributed on an "AS IS" - basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See - the License for the specific language governing rights and limitations - under the License. + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. </legalnotice> diff --git a/lib/hipe/flow/Makefile b/lib/hipe/flow/Makefile index 75e156b542..d883eecf36 100644 --- a/lib/hipe/flow/Makefile +++ b/lib/hipe/flow/Makefile @@ -1,18 +1,19 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2001-2012. All Rights Reserved. +# Copyright Ericsson AB 2001-2016. All Rights Reserved. # -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at # -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. # # %CopyrightEnd% # @@ -65,7 +66,7 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += +warn_exported_vars +warn_missing_spec # +warn_untyped_record +ERL_COMPILE_FLAGS += -Werror +warn_export_vars +warn_missing_spec +warn_untyped_record # ---------------------------------------------------- # Targets diff --git a/lib/hipe/flow/cfg.hrl b/lib/hipe/flow/cfg.hrl index 95bf5f7194..2575b9e38a 100644 --- a/lib/hipe/flow/cfg.hrl +++ b/lib/hipe/flow/cfg.hrl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2012. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -33,21 +34,23 @@ %% -record(cfg_info, {'fun' :: mfa(), start_label :: cfg_lbl(), + %% TODO: merge is_closure and closure_arity into one field is_closure :: boolean(), - closure_arity :: arity(), + closure_arity = none :: 'none' | arity(), is_leaf :: boolean(), - params, % :: list() - info = []}). %% this field seems not needed; take out?? + params :: list(), %% XXX: refine + info = [] :: list()}). %% seems not needed; take out?? +-type cfg_info() :: #cfg_info{}. %% %% Data is a triple with a dict of constants, a list of labels and an integer %% --type cfg_data() :: {dict(), [cfg_lbl()], non_neg_integer()}. +-type cfg_data() :: {dict:dict(), [cfg_lbl()], non_neg_integer()}. %% %% The following is to be used by other modules %% --record(cfg, {table = gb_trees:empty() :: gb_tree(), - info :: #cfg_info{}, +-record(cfg, {table = gb_trees:empty() :: gb_trees:tree(), + info :: cfg_info(), data :: cfg_data()}). -type cfg() :: #cfg{}. diff --git a/lib/hipe/flow/cfg.inc b/lib/hipe/flow/cfg.inc index 62f399a81c..0bad2a8dd7 100644 --- a/lib/hipe/flow/cfg.inc +++ b/lib/hipe/flow/cfg.inc @@ -4,18 +4,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -534,7 +535,7 @@ breadth_list([], Vis, _CFG, BO) -> {Vis, BO}. -endif. --spec none_visited() -> gb_set(). +-spec none_visited() -> gb_sets:set(). none_visited() -> gb_sets:empty(). diff --git a/lib/hipe/flow/ebb.inc b/lib/hipe/flow/ebb.inc index 42d7ff3793..529be72dc8 100644 --- a/lib/hipe/flow/ebb.inc +++ b/lib/hipe/flow/ebb.inc @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/flow/hipe_bb.erl b/lib/hipe/flow/hipe_bb.erl index 16730f1dce..2da3a6dc99 100644 --- a/lib/hipe/flow/hipe_bb.erl +++ b/lib/hipe/flow/hipe_bb.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/flow/hipe_bb.hrl b/lib/hipe/flow/hipe_bb.hrl index f4d426dad1..cd4d788aef 100644 --- a/lib/hipe/flow/hipe_bb.hrl +++ b/lib/hipe/flow/hipe_bb.hrl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/flow/hipe_dominators.erl b/lib/hipe/flow/hipe_dominators.erl index 1f2c830eaf..72c16b5688 100644 --- a/lib/hipe/flow/hipe_dominators.erl +++ b/lib/hipe/flow/hipe_dominators.erl @@ -1,19 +1,20 @@ -%% -*- coding: utf-8; erlang-indent-level: 2 -*- +%% -*- erlang-indent-level: 2 -*- %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2013. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -57,8 +58,8 @@ -record(domTree, {root :: cfg_lbl(), size = 0 :: non_neg_integer(), - nodes = gb_trees:empty() :: gb_tree()}). --type domTree() :: #domTree{}. + nodes = gb_trees:empty() :: gb_trees:tree()}). +-opaque domTree() :: #domTree{}. %%>----------------------------------------------------------------------< %% Procedure : domTree_create/1 @@ -590,7 +591,7 @@ domTree_pp_children([], _) -> %% %%======================================================================== --type domFrontier() :: gb_tree(). +-type domFrontier() :: gb_trees:tree(). %%>----------------------------------------------------------------------< %% Procedure : domFrontier_create diff --git a/lib/hipe/flow/hipe_gen_cfg.erl b/lib/hipe/flow/hipe_gen_cfg.erl index f9fb1f70c8..a6d053f505 100644 --- a/lib/hipe/flow/hipe_gen_cfg.erl +++ b/lib/hipe/flow/hipe_gen_cfg.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% Copyright Ericsson AB 2002-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/flow/liveness.inc b/lib/hipe/flow/liveness.inc index 9c5eaf3e68..a1caa3e0ad 100644 --- a/lib/hipe/flow/liveness.inc +++ b/lib/hipe/flow/liveness.inc @@ -3,18 +3,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -71,7 +72,7 @@ %% The generic liveness analysis %% --spec analyze(cfg()) -> gb_tree(). +-spec analyze(cfg()) -> gb_trees:tree(). -ifdef(HIPE_LIVENESS_CALC_LARGEST_LIVESET). analyze(CFG) -> @@ -209,7 +210,7 @@ successors(L, Liveness) -> {_GK, _LiveIn, Successors} = liveness_lookup(L, Liveness), Successors. --spec livein(gb_tree(), _) -> [_]. +-spec livein(gb_trees:tree(), _) -> [_]. livein(Liveness, L) -> {_GK, LiveIn, _Successors} = liveness_lookup(L, Liveness), diff --git a/lib/hipe/icode/Makefile b/lib/hipe/icode/Makefile index 87015aa51c..b220bc16a0 100644 --- a/lib/hipe/icode/Makefile +++ b/lib/hipe/icode/Makefile @@ -1,18 +1,19 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2001-2013. All Rights Reserved. +# Copyright Ericsson AB 2001-2016. All Rights Reserved. # -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at # -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. # # %CopyrightEnd% # @@ -58,7 +59,7 @@ DOC_MODULES = hipe_beam_to_icode \ hipe_icode_pp hipe_icode_primops \ hipe_icode_range \ hipe_icode_split_arith \ - hipe_icode_ssa hipe_icode_ssa_const_prop \ + hipe_icode_ssa hipe_icode_ssa_const_prop hipe_icode_call_elim \ hipe_icode_ssa_copy_prop hipe_icode_ssa_struct_reuse \ hipe_icode_type $(HIPE_MODULES) @@ -83,7 +84,7 @@ DOC_FILES= $(DOC_MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += +warn_unused_import +warn_exported_vars +warn_missing_spec # +warn_untyped_record +ERL_COMPILE_FLAGS += -Werror +warn_unused_import +warn_export_vars +warn_missing_spec # +warn_untyped_record # ---------------------------------------------------- # Targets diff --git a/lib/hipe/icode/hipe_beam_to_icode.erl b/lib/hipe/icode/hipe_beam_to_icode.erl index 81249c958e..224aacd8d7 100644 --- a/lib/hipe/icode/hipe_beam_to_icode.erl +++ b/lib/hipe/icode/hipe_beam_to_icode.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2012. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -509,6 +510,10 @@ trans_fun([{test,test_arity,{f,Lbl},[Reg,N]}|Instructions], Env) -> I = hipe_icode:mk_type([trans_arg(Reg)],{tuple,N}, hipe_icode:label_name(True),map_label(Lbl)), [I,True | trans_fun(Instructions,Env)]; +%%--- is_map --- +trans_fun([{test,is_map,{f,Lbl},[Arg]}|Instructions], Env) -> + {Code,Env1} = trans_type_test(map,Lbl,Arg,Env), + [Code | trans_fun(Instructions,Env1)]; %%-------------------------------------------------------------------- %%--- select_val --- trans_fun([{select_val,Reg,{f,Lbl},{list,Cases}}|Instructions], Env) -> @@ -876,6 +881,15 @@ trans_fun([{bs_init_bits,{f,Lbl},Size,_Words,_LiveRegs,{field_flags,Flags0},X}| trans_fun([{bs_add, {f,Lbl}, [Old,New,Unit], Res}|Instructions], Env) -> Dst = mk_var(Res), Temp = mk_var(new), + {FailLblName, FailCode} = + if Lbl =:= 0 -> + FailLbl = mk_label(new), + {hipe_icode:label_name(FailLbl), + [FailLbl, + hipe_icode:mk_fail([hipe_icode:mk_const(badarg)], error)]}; + true -> + {map_label(Lbl), []} + end, MultIs = case {New,Unit} of {{integer, NewInt}, _} -> @@ -885,40 +899,26 @@ trans_fun([{bs_add, {f,Lbl}, [Old,New,Unit], Res}|Instructions], Env) -> [hipe_icode:mk_move(Temp, NewVar)]; _ -> NewVar = mk_var(New), - if Lbl =:= 0 -> - [hipe_icode:mk_primop([Temp], '*', - [NewVar, hipe_icode:mk_const(Unit)])]; - true -> - Succ = mk_label(new), - [hipe_icode:mk_primop([Temp], '*', - [NewVar, hipe_icode:mk_const(Unit)], - hipe_icode:label_name(Succ), map_label(Lbl)), - Succ] - end + Succ = mk_label(new), + [hipe_icode:mk_primop([Temp], '*', + [NewVar, hipe_icode:mk_const(Unit)], + hipe_icode:label_name(Succ), FailLblName), + Succ] end, Succ2 = mk_label(new), - {FailLblName, FailCode} = - if Lbl =:= 0 -> - FailLbl = mk_label(new), - {hipe_icode:label_name(FailLbl), - [FailLbl, - hipe_icode:mk_fail([hipe_icode:mk_const(badarg)], error)]}; - true -> - {map_label(Lbl), []} - end, IsPos = [hipe_icode:mk_if('>=', [Temp, hipe_icode:mk_const(0)], hipe_icode:label_name(Succ2), FailLblName)] ++ - FailCode ++ [Succ2], - AddI = + FailCode ++ [Succ2], + AddRhs = case Old of - {integer,OldInt} -> - hipe_icode:mk_primop([Dst], '+', [Temp, hipe_icode:mk_const(OldInt)]); - _ -> - OldVar = mk_var(Old), - hipe_icode:mk_primop([Dst], '+', [Temp, OldVar]) + {integer,OldInt} -> hipe_icode:mk_const(OldInt); + _ -> mk_var(Old) end, - MultIs ++ IsPos ++ [AddI|trans_fun(Instructions, Env)]; + Succ3 = mk_label(new), + AddI = hipe_icode:mk_primop([Dst], '+', [Temp, AddRhs], + hipe_icode:label_name(Succ3), FailLblName), + MultIs ++ IsPos ++ [AddI,Succ3|trans_fun(Instructions, Env)]; %%-------------------------------------------------------------------- %% Bit syntax instructions added in R12B-5 (Fall 2008) %%-------------------------------------------------------------------- @@ -1121,6 +1121,49 @@ trans_fun([{trim,N,NY}|Instructions], Env) -> trans_fun([{line,_}|Instructions], Env) -> trans_fun(Instructions,Env); %%-------------------------------------------------------------------- +%% Map instructions added in Spring 2014 (17.0). +%%-------------------------------------------------------------------- +trans_fun([{test,has_map_fields,{f,Lbl},Map,{list,Keys}}|Instructions], Env) -> + {MapMove, MapVar, Env1} = mk_move_and_var(Map, Env), + %% We assume that hipe_icode:mk_call has no side-effects, and reuse + %% the help function of get_map_elements below, discarding the value + %% assignment instruction list. + {TestInstructions, _GetInstructions, Env2} = + trans_map_query(MapVar, map_label(Lbl), Env1, + lists:flatten([[K, {r, 0}] || K <- Keys])), + [MapMove, TestInstructions | trans_fun(Instructions, Env2)]; +trans_fun([{get_map_elements,{f,Lbl},Map,{list,KVPs}}|Instructions], Env) -> + {MapMove, MapVar, Env1} = mk_move_and_var(Map, Env), + {TestInstructions, GetInstructions, Env2} = + trans_map_query(MapVar, map_label(Lbl), Env1, KVPs), + [MapMove, TestInstructions, GetInstructions | trans_fun(Instructions, Env2)]; +%%--- put_map_assoc --- +trans_fun([{put_map_assoc,{f,Lbl},Map,Dst,_N,{list,Pairs}}|Instructions], Env) -> + {MapMove, MapVar, Env1} = mk_move_and_var(Map, Env), + TempMapVar = mk_var(new), + TempMapMove = hipe_icode:mk_move(TempMapVar, MapVar), + {PutInstructions, Env2} + = case Lbl > 0 of + true -> + gen_put_map_instrs(exists, assoc, TempMapVar, Dst, Lbl, Pairs, Env1); + false -> + gen_put_map_instrs(new, assoc, TempMapVar, Dst, new, Pairs, Env1) + end, + [MapMove, TempMapMove, PutInstructions | trans_fun(Instructions, Env2)]; +%%--- put_map_exact --- +trans_fun([{put_map_exact,{f,Lbl},Map,Dst,_N,{list,Pairs}}|Instructions], Env) -> + {MapMove, MapVar, Env1} = mk_move_and_var(Map, Env), + TempMapVar = mk_var(new), + TempMapMove = hipe_icode:mk_move(TempMapVar, MapVar), + {PutInstructions, Env2} + = case Lbl > 0 of + true -> + gen_put_map_instrs(exists, exact, TempMapVar, Dst, Lbl, Pairs, Env1); + false -> + gen_put_map_instrs(new, exact, TempMapVar, Dst, new, Pairs, Env1) + end, + [MapMove, TempMapMove, PutInstructions | trans_fun(Instructions, Env2)]; +%%-------------------------------------------------------------------- %%--- ERROR HANDLING --- %%-------------------------------------------------------------------- trans_fun([X|_], _) -> @@ -1258,7 +1301,7 @@ trans_bin([{bs_put_binary,{f,Lbl},Size,Unit,{field_flags,Flags},Source}| {Name, Args, Env2} = case Size of {atom,all} -> %% put all bits - {{bs_put_binary_all, Flags}, [Src,Base,Offset], Env}; + {{bs_put_binary_all, Unit, Flags}, [Src,Base,Offset], Env}; {integer,NoBits} when is_integer(NoBits), NoBits >= 0 -> %% Create a N*Unit bits subbinary {{bs_put_binary, NoBits*Unit, Flags}, [Src,Base,Offset], Env}; @@ -1500,6 +1543,105 @@ trans_type_test2(function2, Lbl, Arg, Arity, Env) -> hipe_icode:label_name(True), map_label(Lbl)), {[Move1,Move2,I,True],Env2}. +%% +%% Handles the get_map_elements instruction and the has_map_fields +%% test instruction. +%% +trans_map_query(_MapVar, _FailLabel, Env, []) -> + {[], [], Env}; +trans_map_query(MapVar, FailLabel, Env, [Key,Val|KVPs]) -> + {Move,KeyVar,Env1} = mk_move_and_var(Key,Env), + PassLabel = mk_label(new), + BoolVar = hipe_icode:mk_new_var(), + ValVar = mk_var(Val), + IsKeyCall = hipe_icode:mk_call([BoolVar], maps, is_key, [KeyVar, MapVar], + remote), + TrueTest = hipe_icode:mk_if('=:=', [BoolVar, hipe_icode:mk_const(true)], + hipe_icode:label_name(PassLabel), FailLabel), + GetCall = hipe_icode:mk_call([ValVar], maps, get, [KeyVar, MapVar], remote), + {TestList, GetList, Env2} = trans_map_query(MapVar, FailLabel, Env1, KVPs), + {[Move, IsKeyCall, TrueTest, PassLabel|TestList], [GetCall|GetList], Env2}. + +%% +%% Generates a fail label if necessary when translating put_map_* instructions. +%% +gen_put_map_instrs(exists, Op, TempMapVar, Dst, FailLbl, Pairs, Env) -> + TrueLabel = mk_label(new), + IsMapCode = hipe_icode:mk_type([TempMapVar], map, + hipe_icode:label_name(TrueLabel), map_label(FailLbl)), + DstMapVar = mk_var(Dst), + {ReturnLbl, PutInstructions, Env1} + = case Op of + assoc -> + trans_put_map_assoc(TempMapVar, DstMapVar, Pairs, Env, []); + exact -> + trans_put_map_exact(TempMapVar, DstMapVar, + map_label(FailLbl), Pairs, Env, []) + end, + {[IsMapCode, TrueLabel, PutInstructions, ReturnLbl], Env1}; +gen_put_map_instrs(new, Op, TempMapVar, Dst, new, Pairs, Env) -> + FailLbl = mk_label(new), + DstMapVar = mk_var(Dst), + {ReturnLbl, PutInstructions, Env1} + = case Op of + assoc -> + trans_put_map_assoc(TempMapVar, DstMapVar, Pairs, Env, []); + exact -> + trans_put_map_exact(TempMapVar, DstMapVar, + none, Pairs, Env, []) + end, + Fail = hipe_icode:mk_fail([hipe_icode:mk_const(badarg)], error), + {[PutInstructions, FailLbl, Fail, ReturnLbl], Env1}. + +%%----------------------------------------------------------------------- +%% This function generates the instructions needed to insert several +%% (Key, Value) pairs into an existing map, each recursive call inserts +%% one (Key, Value) pair. +%%----------------------------------------------------------------------- +trans_put_map_assoc(MapVar, DestMapVar, [], Env, Acc) -> + MoveToReturnVar = hipe_icode:mk_move(DestMapVar, MapVar), + ReturnLbl = mk_label(new), + GotoReturn = hipe_icode:mk_goto(hipe_icode:label_name(ReturnLbl)), + {ReturnLbl, lists:reverse([GotoReturn, MoveToReturnVar | Acc]), Env}; +trans_put_map_assoc(MapVar, DestMapVar, [Key, Value | Rest], Env, Acc) -> + {MoveKey, KeyVar, Env1} = mk_move_and_var(Key, Env), + {MoveVal, ValVar, Env2} = mk_move_and_var(Value, Env1), + BifCall = hipe_icode:mk_call([MapVar], maps, put, + [KeyVar, ValVar, MapVar], remote), + trans_put_map_assoc(MapVar, DestMapVar, Rest, Env2, + [BifCall, MoveVal, MoveKey | Acc]). + +%%----------------------------------------------------------------------- +%% This function generates the instructions needed to update several +%% (Key, Value) pairs in an existing map, each recursive call inserts +%% one (Key, Value) pair. +%%----------------------------------------------------------------------- +trans_put_map_exact(MapVar, DestMapVar, _FLbl, [], Env, Acc) -> + MoveToReturnVar = hipe_icode:mk_move(DestMapVar, MapVar), + ReturnLbl = mk_label(new), + GotoReturn = hipe_icode:mk_goto(hipe_icode:label_name(ReturnLbl)), + {ReturnLbl, lists:reverse([GotoReturn, MoveToReturnVar | Acc]), Env}; +trans_put_map_exact(MapVar, DestMapVar, none, [Key, Value | Rest], Env, Acc) -> + {MoveKey, KeyVar, Env1} = mk_move_and_var(Key, Env), + {MoveVal, ValVar, Env2} = mk_move_and_var(Value, Env1), + BifCallPut = hipe_icode:mk_call([MapVar], maps, update, + [KeyVar, ValVar, MapVar], remote), + Acc1 = [BifCallPut, MoveVal, MoveKey | Acc], + trans_put_map_exact(MapVar, DestMapVar, none, Rest, Env2, Acc1); +trans_put_map_exact(MapVar, DestMapVar, FLbl, [Key, Value | Rest], Env, Acc) -> + SuccLbl = mk_label(new), + {MoveKey, KeyVar, Env1} = mk_move_and_var(Key, Env), + {MoveVal, ValVar, Env2} = mk_move_and_var(Value, Env1), + IsKey = hipe_icode:mk_new_var(), + BifCallIsKey = hipe_icode:mk_call([IsKey], maps, is_key, + [KeyVar, MapVar], remote), + IsKeyTest = hipe_icode:mk_if('=:=', [IsKey, hipe_icode:mk_const(true)], + hipe_icode:label_name(SuccLbl), FLbl), + BifCallPut = hipe_icode:mk_call([MapVar], maps, put, + [KeyVar, ValVar, MapVar], remote), + Acc1 = [BifCallPut, SuccLbl, IsKeyTest, BifCallIsKey, MoveVal, MoveKey | Acc], + trans_put_map_exact(MapVar, DestMapVar, FLbl, Rest, Env2, Acc1). + %%----------------------------------------------------------------------- %% trans_puts(Code, Environment) -> %% {Movs, Code, Vars, NewEnv} diff --git a/lib/hipe/icode/hipe_icode.erl b/lib/hipe/icode/hipe_icode.erl index 6d4758bbf1..78508dff22 100644 --- a/lib/hipe/icode/hipe_icode.erl +++ b/lib/hipe/icode/hipe_icode.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% Copyright Ericsson AB 2001-2015. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -503,7 +504,6 @@ enter_args_update/2, enter_type/1, is_enter/1, - mk_return/1, %% mk_return(Vars) %% mk_fail/1, %% mk_fail(Args) class = exit @@ -606,15 +606,23 @@ -export([highest_var/1, highest_label/1]). +%% +%% Exported types +%% + +-export_type([icode/0, params/0]). + +-type params() :: [icode_var()]. + %%--------------------------------------------------------------------- %% %% Icode %% %%--------------------------------------------------------------------- --spec mk_icode(mfa(), [icode_var()], boolean(), boolean(), [icode_instr()], +-spec mk_icode(mfa(), params(), boolean(), boolean(), [icode_instr()], {non_neg_integer(),non_neg_integer()}, - {icode_lbl(),icode_lbl()}) -> #icode{}. + {icode_lbl(),icode_lbl()}) -> icode(). mk_icode(Fun, Params, IsClosure, IsLeaf, Code, VarRange, LabelRange) -> #icode{'fun'=Fun, params=Params, code=Code, is_closure=IsClosure, @@ -623,61 +631,61 @@ mk_icode(Fun, Params, IsClosure, IsLeaf, Code, VarRange, LabelRange) -> var_range=VarRange, label_range=LabelRange}. --spec mk_icode(mfa(), [icode_var()], boolean(), boolean(), [icode_instr()], +-spec mk_icode(mfa(), params(), boolean(), boolean(), [icode_instr()], hipe_consttab(), {non_neg_integer(),non_neg_integer()}, - {icode_lbl(),icode_lbl()}) -> #icode{}. + {icode_lbl(),icode_lbl()}) -> icode(). mk_icode(Fun, Params, IsClosure, IsLeaf, Code, Data, VarRange, LabelRange) -> #icode{'fun'=Fun, params=Params, code=Code, data=Data, is_closure=IsClosure, is_leaf=IsLeaf, var_range=VarRange, label_range=LabelRange}. --spec icode_fun(#icode{}) -> mfa(). +-spec icode_fun(icode()) -> mfa(). icode_fun(#icode{'fun' = MFA}) -> MFA. --spec icode_params(#icode{}) -> [icode_var()]. +-spec icode_params(icode()) -> params(). icode_params(#icode{params = Params}) -> Params. --spec icode_params_update(#icode{}, [icode_var()]) -> #icode{}. -icode_params_update(Icode, Params) -> +-spec icode_params_update(icode(), params()) -> icode(). +icode_params_update(Icode, Params) -> Icode#icode{params = Params}. --spec icode_is_closure(#icode{}) -> boolean(). +-spec icode_is_closure(icode()) -> boolean(). icode_is_closure(#icode{is_closure = Closure}) -> Closure. --spec icode_is_leaf(#icode{}) -> boolean(). +-spec icode_is_leaf(icode()) -> boolean(). icode_is_leaf(#icode{is_leaf = Leaf}) -> Leaf. --spec icode_code(#icode{}) -> icode_instrs(). +-spec icode_code(icode()) -> icode_instrs(). icode_code(#icode{code = Code}) -> Code. --spec icode_code_update(#icode{}, icode_instrs()) -> #icode{}. +-spec icode_code_update(icode(), icode_instrs()) -> icode(). icode_code_update(Icode, NewCode) -> Vmax = highest_var(NewCode), Lmax = highest_label(NewCode), Icode#icode{code = NewCode, var_range = {0,Vmax}, label_range = {0,Lmax}}. --spec icode_data(#icode{}) -> hipe_consttab(). +-spec icode_data(icode()) -> hipe_consttab(). icode_data(#icode{data=Data}) -> Data. -%% %% -spec icode_data_update(#icode{}, hipe_consttab()) -> #icode{}. +%% %% -spec icode_data_update(icode(), hipe_consttab()) -> icode(). %% icode_data_update(Icode, NewData) -> Icode#icode{data=NewData}. --spec icode_var_range(#icode{}) -> {non_neg_integer(), non_neg_integer()}. +-spec icode_var_range(icode()) -> {non_neg_integer(), non_neg_integer()}. icode_var_range(#icode{var_range = VarRange}) -> VarRange. --spec icode_label_range(#icode{}) -> {non_neg_integer(), non_neg_integer()}. +-spec icode_label_range(icode()) -> {non_neg_integer(), non_neg_integer()}. icode_label_range(#icode{label_range = LabelRange}) -> LabelRange. --spec icode_info(#icode{}) -> icode_info(). +-spec icode_info(icode()) -> icode_info(). icode_info(#icode{info = Info}) -> Info. --spec icode_info_update(#icode{}, icode_info()) -> #icode{}. +-spec icode_info_update(icode(), icode_info()) -> icode(). icode_info_update(Icode, Info) -> Icode#icode{info = Info}. --spec icode_closure_arity(#icode{}) -> arity(). +-spec icode_closure_arity(icode()) -> arity(). icode_closure_arity(#icode{closure_arity = Arity}) -> Arity. --spec icode_closure_arity_update(#icode{}, arity()) -> #icode{}. +-spec icode_closure_arity_update(icode(), arity()) -> icode(). icode_closure_arity_update(Icode, Arity) -> Icode#icode{closure_arity = Arity}. @@ -1370,12 +1378,12 @@ remove_constants(L) -> %% Substitution: replace occurrences of X by Y if {X,Y} is in the %% Subst_list. --spec subst([{_,_}], I) -> I when is_subtype(I, icode_instr()). +-spec subst([{_,_}], I) -> I when I :: icode_instr(). subst(Subst, I) -> subst_defines(Subst, subst_uses(Subst, I)). --spec subst_uses([{_,_}], I) -> I when is_subtype(I, icode_instr()). +-spec subst_uses([{_,_}], I) -> I when I :: icode_instr(). subst_uses(Subst, I) -> case I of @@ -1399,7 +1407,7 @@ subst_uses(Subst, I) -> #icode_label{} -> I end. --spec subst_defines([{_,_}], I) -> I when is_subtype(I, icode_instr()). +-spec subst_defines([{_,_}], I) -> I when I :: icode_instr(). subst_defines(Subst, I) -> case I of @@ -1434,8 +1442,8 @@ subst1([_|Pairs], I) -> subst1(Pairs, I). %% %% @doc Returns the successors of an Icode instruction. %% In CFG form only branch instructions have successors, -%% but in linear form other instructions like e.g. moves and -%% others might be the last instruction of some basic block. +%% but in linear form other instructions like e.g. moves +%% might be the last instruction of some basic block. %% -spec successors(icode_instr()) -> [icode_lbl()]. @@ -1464,6 +1472,7 @@ successors(I) -> case fail_label(I) of [] -> []; L when is_integer(L) -> [L] end; #icode_enter{} -> []; #icode_return{} -> []; + #icode_comment{} -> []; %% the following are included here for handling linear code #icode_move{} -> []; #icode_begin_handler{} -> [] @@ -1702,7 +1711,7 @@ mk_new_label() -> %% @doc Removes comments from Icode. %% --spec strip_comments(#icode{}) -> #icode{}. +-spec strip_comments(icode()) -> icode(). strip_comments(ICode) -> icode_code_update(ICode, no_comments(icode_code(ICode))). diff --git a/lib/hipe/icode/hipe_icode.hrl b/lib/hipe/icode/hipe_icode.hrl index 060493e61e..b2e0d86b28 100644 --- a/lib/hipe/icode/hipe_icode.hrl +++ b/lib/hipe/icode/hipe_icode.hrl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2013. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -61,8 +62,8 @@ | 'op_exact_eqeq_2' | 'suspend_msg_timeout'. -type icode_type_test() :: 'atom' | 'bignum' | 'binary' | 'bitstr' | 'boolean' - | 'cons' | 'fixnum' | 'float' - | 'function' | 'function2' | 'integer' | 'list' | 'nil' + | 'cons' | 'fixnum' | 'float' | 'function' + | 'function2' | 'integer' | 'list' | 'map' | 'nil' | 'number' | 'pid' | 'port' | 'reference' | 'tuple' | {'atom', atom()} | {'integer', integer()} | {'record', atom(), non_neg_integer()} @@ -108,7 +109,6 @@ length :: non_neg_integer(), cases :: [icode_switch_case()]}). - -record(icode_type, {test :: icode_type_test(), args :: [icode_term_arg()], true_label :: icode_lbl(), @@ -169,14 +169,16 @@ %%--------------------------------------------------------------------- -record(icode, {'fun' :: mfa(), - params :: [icode_var()], + params :: hipe_icode:params(), + %% TODO: merge is_closure and closure_arity into one field is_closure :: boolean(), - closure_arity :: arity(), + closure_arity = none :: 'none' | arity(), is_leaf :: boolean(), code = [] :: icode_instrs(), data :: hipe_consttab(), var_range :: {non_neg_integer(), non_neg_integer()}, label_range :: {icode_lbl(), icode_lbl()}, info = [] :: icode_info()}). +-type icode() :: #icode{}. %%--------------------------------------------------------------------- diff --git a/lib/hipe/icode/hipe_icode_bincomp.erl b/lib/hipe/icode/hipe_icode_bincomp.erl index 6f694f2bce..5a27519141 100644 --- a/lib/hipe/icode/hipe_icode_bincomp.erl +++ b/lib/hipe/icode/hipe_icode_bincomp.erl @@ -2,18 +2,19 @@ %%% %%% %CopyrightBegin% %%% -%%% Copyright Ericsson AB 2006-2009. All Rights Reserved. +%%% Copyright Ericsson AB 2006-2016. All Rights Reserved. %%% -%%% The contents of this file are subject to the Erlang Public License, -%%% Version 1.1, (the "License"); you may not use this file except in -%%% compliance with the License. You should have received a copy of the -%%% Erlang Public License along with this software. If not, it can be -%%% retrieved online at http://www.erlang.org/. -%%% -%%% Software distributed under the License is distributed on an "AS IS" -%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%%% the License for the specific language governing rights and limitations -%%% under the License. +%%% Licensed under the Apache License, Version 2.0 (the "License"); +%%% you may not use this file except in compliance with the License. +%%% You may obtain a copy of the License at +%%% +%%% http://www.apache.org/licenses/LICENSE-2.0 +%%% +%%% Unless required by applicable law or agreed to in writing, software +%%% distributed under the License is distributed on an "AS IS" BASIS, +%%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%%% See the License for the specific language governing permissions and +%%% limitations under the License. %%% %%% %CopyrightEnd% %%% diff --git a/lib/hipe/icode/hipe_icode_call_elim.erl b/lib/hipe/icode/hipe_icode_call_elim.erl new file mode 100644 index 0000000000..6a22133962 --- /dev/null +++ b/lib/hipe/icode/hipe_icode_call_elim.erl @@ -0,0 +1,78 @@ +%% -*- erlang-indent-level: 2 -*- +%% +%% %CopyrightBegin% +%% +%% Copyright Ericsson AB 2016. All Rights Reserved. +%% +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% %CopyrightEnd% +%% +%%---------------------------------------------------------------------- +%% File : hipe_icode_call_elim.erl +%% Authors : Daniel S. McCain <[email protected]>, +%% Magnus Lång <[email protected]> +%% Created : 14 Apr 2014 by Magnus Lång <[email protected]> +%% Purpose : Eliminate calls to BIFs that are side-effect free only when +%% executed on some argument types. +%%---------------------------------------------------------------------- +-module(hipe_icode_call_elim). +-export([cfg/1]). + +-include("hipe_icode.hrl"). +-include("../flow/cfg.hrl"). + +-spec cfg(cfg()) -> cfg(). + +cfg(IcodeSSA) -> + lists:foldl(fun (Lbl, CFG1) -> + BB1 = hipe_icode_cfg:bb(CFG1, Lbl), + Code1 = hipe_bb:code(BB1), + Code2 = lists:map(fun elim_insn/1, Code1), + BB2 = hipe_bb:code_update(BB1, Code2), + hipe_icode_cfg:bb_add(CFG1, Lbl, BB2) + end, IcodeSSA, hipe_icode_cfg:labels(IcodeSSA)). + +-spec elim_insn(icode_instr()) -> icode_instr(). +elim_insn(Insn=#icode_call{'fun'={_,_,_}=MFA, args=Args, type=remote, + dstlist=[Dst=#icode_variable{ + annotation={type_anno, RetType, _}}]}) -> + Opaques = 'universe', + case erl_types:t_is_singleton(RetType, Opaques) of + true -> + ArgTypes = [case Arg of + #icode_variable{annotation={type_anno, Type, _}} -> Type; + #icode_const{} -> + erl_types:t_from_term(hipe_icode:const_value(Arg)) + end || Arg <- Args], + case can_be_eliminated(MFA, ArgTypes) of + true -> + Const = hipe_icode:mk_const( + erl_types:t_singleton_to_term(RetType, Opaques)), + #icode_move{dst=Dst, src=Const}; + false -> Insn + end; + false -> Insn + end; +elim_insn(Insn) -> Insn. + + +%% A function can be eliminated for some argument types if it has no side +%% effects when run on arguments of those types. + +-spec can_be_eliminated(mfa(), [erl_types:erl_type()]) -> boolean(). + +can_be_eliminated({maps, is_key, 2}, [_K, M]) -> + erl_types:t_is_map(M); +can_be_eliminated(_, _) -> + false. diff --git a/lib/hipe/icode/hipe_icode_callgraph.erl b/lib/hipe/icode/hipe_icode_callgraph.erl index 5789328f47..12c2cd2b44 100644 --- a/lib/hipe/icode/hipe_icode_callgraph.erl +++ b/lib/hipe/icode/hipe_icode_callgraph.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2013. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -46,7 +47,7 @@ -type mfa_icode() :: {mfa(), #icode{}}. --record(icode_callgraph, {codedict :: dict(), ordered_sccs :: [[mfa()]]}). +-record(icode_callgraph, {codedict :: dict:dict(), ordered_sccs :: [[mfa()]]}). %%------------------------------------------------------------------------ %% Exported functions diff --git a/lib/hipe/icode/hipe_icode_cfg.erl b/lib/hipe/icode/hipe_icode_cfg.erl index 9b4a10e273..9a602c0283 100644 --- a/lib/hipe/icode/hipe_icode_cfg.erl +++ b/lib/hipe/icode/hipe_icode_cfg.erl @@ -3,18 +3,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -54,8 +55,11 @@ -spec postorder(cfg()) -> [icode_lbl()]. -spec reverse_postorder(cfg()) -> [icode_lbl()]. --spec is_visited(icode_lbl(), gb_set()) -> boolean(). --spec visit(icode_lbl(), gb_set()) -> gb_set(). +-spec params(cfg()) -> hipe_icode:params(). +-spec params_update(cfg(), hipe_icode:params()) -> cfg(). + +-spec is_visited(icode_lbl(), gb_sets:set()) -> boolean(). +-spec visit(icode_lbl(), gb_sets:set()) -> gb_sets:set(). -spec bb(cfg(), icode_lbl()) -> 'not_found' | bb(). -spec bb_add(cfg(), icode_lbl(), bb()) -> cfg(). diff --git a/lib/hipe/icode/hipe_icode_coordinator.erl b/lib/hipe/icode/hipe_icode_coordinator.erl index 79e3304e6f..d2f8748535 100644 --- a/lib/hipe/icode/hipe_icode_coordinator.erl +++ b/lib/hipe/icode/hipe_icode_coordinator.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -49,9 +50,9 @@ coordinate(CG, Escaping, NonEscaping, Mod) -> -type mfalists() :: {[mfa()], [mfa()]}. --spec coordinate(mfalists(), hipe_digraph:hdg(), gb_tree(), - fun((mfalists(), gb_tree()) -> mfalists()), - fun((gb_tree()) -> 'ok'), pid()) -> no_return(). +-spec coordinate(mfalists(), hipe_digraph:hdg(), gb_trees:tree(), + fun((mfalists(), gb_trees:tree()) -> mfalists()), + fun((gb_trees:tree()) -> 'ok'), pid()) -> no_return(). coordinate(MFALists, CG, PM, Restart, LastAction, ServerPid) -> case MFALists of diff --git a/lib/hipe/icode/hipe_icode_ebb.erl b/lib/hipe/icode/hipe_icode_ebb.erl index 966c4d7564..2aac9d2f42 100644 --- a/lib/hipe/icode/hipe_icode_ebb.erl +++ b/lib/hipe/icode/hipe_icode_ebb.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/icode/hipe_icode_exceptions.erl b/lib/hipe/icode/hipe_icode_exceptions.erl index 00caffb24b..f03ce2faaa 100644 --- a/lib/hipe/icode/hipe_icode_exceptions.erl +++ b/lib/hipe/icode/hipe_icode_exceptions.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2011. All Rights Reserved. +%% Copyright Ericsson AB 2004-2015. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -84,7 +85,7 @@ %%---------------------------------------------------------------------------- --spec fix_catches(#cfg{}) -> #cfg{}. +-spec fix_catches(cfg()) -> cfg(). fix_catches(CFG) -> {Map, State} = build_mapping(find_catches(init_state(CFG))), @@ -392,24 +393,19 @@ get_renaming(C, Map) -> %%--------------------------------------------------------------------- %% State abstraction --record(state, {cfg :: #cfg{}, +-record(state, {cfg :: cfg(), changed = false :: boolean(), - succ :: #cfg{}, - pred :: #cfg{}, + succ :: cfg(), + pred :: cfg(), start_labels :: [icode_lbl(),...], - visited = hipe_icode_cfg:none_visited() :: gb_set(), - out = gb_trees:empty() :: gb_tree(), - in = gb_trees:empty() :: gb_tree() + visited = hipe_icode_cfg:none_visited() :: gb_sets:set(), + out = gb_trees:empty() :: gb_trees:tree(), + in = gb_trees:empty() :: gb_trees:tree() }). init_state(CFG) -> - State = #state{cfg = CFG}, - refresh_state_cache(State). - -refresh_state_cache(State) -> - CFG = State#state.cfg, SLs = [hipe_icode_cfg:start_label(CFG)], - State#state{succ = CFG, pred = CFG, start_labels = SLs}. + #state{cfg = CFG, succ = CFG, pred = CFG, start_labels = SLs}. get_cfg(State) -> State#state.cfg. @@ -465,7 +461,8 @@ get_bb_code(L, State) -> set_bb_code(L, Code, State) -> CFG = State#state.cfg, CFG1 = hipe_icode_cfg:bb_add(CFG, L, hipe_bb:mk_bb(Code)), - refresh_state_cache(State#state{cfg = CFG1}). + SLs = [hipe_icode_cfg:start_label(CFG1)], + State#state{cfg = CFG1, succ = CFG1, pred = CFG1, start_labels = SLs}. get_new_catches_in(L, State) -> Ps = get_pred(L, State), diff --git a/lib/hipe/icode/hipe_icode_fp.erl b/lib/hipe/icode/hipe_icode_fp.erl index a2ca6132d1..4a5877074c 100644 --- a/lib/hipe/icode/hipe_icode_fp.erl +++ b/lib/hipe/icode/hipe_icode_fp.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2009. All Rights Reserved. +%% Copyright Ericsson AB 2003-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -33,13 +34,37 @@ -include("hipe_icode.hrl"). -include("../flow/cfg.hrl"). --record(state, {edge_map = gb_trees:empty() :: gb_tree(), - fp_ebb_map = gb_trees:empty() :: gb_tree(), - cfg :: #cfg{}}). +-type mapped_fvar() :: icode_fvar() | {assigned, icode_fvar()} . +-type incoming_fvars() :: [{icode_lbl(), mapped_fvar()}]. +-type initial_var_map() :: #{icode_var() => incoming_fvars()}. +-type bb_phi_list() :: [{icode_fvar(), [{icode_lbl(), icode_fvar()}]}]. +-type var_map_phi() :: #{phi => bb_phi_list(), + icode_var() => mapped_fvar()}. +-type var_map() :: #{icode_var() => mapped_fvar()}. + +-type edge() :: {icode_lbl(), icode_lbl()}. +-type edge_map() :: #{edge() => var_map()}. + +-type worklist(Item) :: {[Item], [Item], gb_sets:set(Item)}. +-type worklist() :: worklist(icode_lbl()). + +-type fail_lbl() :: [] | icode_lbl(). +-type in_block() :: {true, fail_lbl()} | false. +-type fp_ebb_map() :: #{{inblock_in | inblock_out, icode_lbl()} | edge() + => in_block()}. + +-record(state, {edge_map = #{} :: edge_map(), + fp_ebb_map = #{} :: fp_ebb_map(), + cfg :: cfg()}). +-type state() :: #state{}. + +-type icode_phi() :: #icode_phi{}. +-type icode_variable() :: #icode_variable{}. +-type icode_const() :: #icode_const{}. %%-------------------------------------------------------------------- --spec cfg(#cfg{}) -> #cfg{}. +-spec cfg(cfg()) -> cfg(). cfg(Cfg) -> %%hipe_icode_cfg:pp(Cfg), @@ -58,10 +83,14 @@ cfg(Cfg) -> %% corresponding fcheckerror. %%-------------------------------------------------------------------- +-spec annotate_fclearerror(cfg()) -> cfg(). + annotate_fclearerror(Cfg) -> Labels = hipe_icode_cfg:reverse_postorder(Cfg), annotate_fclearerror(Labels, Cfg). +-spec annotate_fclearerror([icode_lbl()], cfg()) -> cfg(). + annotate_fclearerror([Label|Left], Cfg) -> BB = hipe_icode_cfg:bb(Cfg, Label), Code = hipe_bb:code(BB), @@ -72,6 +101,9 @@ annotate_fclearerror([Label|Left], Cfg) -> annotate_fclearerror([], Cfg) -> Cfg. +-spec annotate_fclearerror1(icode_instrs(), icode_lbl(), cfg(), icode_instrs()) + -> icode_instrs(). + annotate_fclearerror1([I|Left], Label, Cfg, Acc) -> case I of #icode_call{} -> @@ -89,6 +121,9 @@ annotate_fclearerror1([I|Left], Label, Cfg, Acc) -> annotate_fclearerror1([], _Label, _Cfg, Acc) -> lists:reverse(Acc). +-spec lookahead_for_fcheckerror(icode_instrs(), icode_lbl(), cfg()) -> + fail_lbl(). + lookahead_for_fcheckerror([I|Left], Label, Cfg) -> case I of #icode_call{} -> @@ -110,10 +145,14 @@ lookahead_for_fcheckerror([], Label, Cfg) -> lookahead_for_fcheckerror(Code, Succ, Cfg) end. +-spec unannotate_fclearerror(cfg()) -> cfg(). + unannotate_fclearerror(Cfg) -> Labels = hipe_icode_cfg:reverse_postorder(Cfg), unannotate_fclearerror(Labels, Cfg). +-spec unannotate_fclearerror([icode_lbl()], cfg()) -> cfg(). + unannotate_fclearerror([Label|Left], Cfg) -> BB = hipe_icode_cfg:bb(Cfg, Label), Code = hipe_bb:code(BB), @@ -124,6 +163,9 @@ unannotate_fclearerror([Label|Left], Cfg) -> unannotate_fclearerror([], Cfg) -> Cfg. +-spec unannotate_fclearerror1(icode_instrs(), icode_instrs()) -> + icode_instrs(). + unannotate_fclearerror1([I|Left], Acc) -> case I of #icode_call{} -> @@ -144,10 +186,14 @@ unannotate_fclearerror1([], Acc) -> %% Make float EBBs %%-------------------------------------------------------------------- +-spec place_fp_blocks(state()) -> state(). + place_fp_blocks(State) -> WorkList = new_worklist(State), transform_block(WorkList, State). +-spec transform_block(worklist(), state()) -> state(). + transform_block(WorkList, State) -> case get_work(WorkList) of none -> @@ -181,6 +227,10 @@ transform_block(WorkList, State) -> end end. +-spec update_maps(state(), icode_lbl(), ordsets:ordset(icode_lbl()), + var_map(), ordsets:ordset(icode_lbl()), var_map()) + -> fixpoint | {state(), [icode_lbl()]}. + update_maps(State, Label, SuccSet, SuccMap, FailSet, FailMap) -> {NewState, Add1} = update_maps(State, Label, SuccSet, SuccMap, []), case update_maps(NewState, Label, FailSet, FailMap, Add1) of @@ -188,6 +238,10 @@ update_maps(State, Label, SuccSet, SuccMap, FailSet, FailMap) -> {_NewState1, _Add} = Ret -> Ret end. +-spec update_maps(state(), icode_lbl(), ordsets:ordset(icode_lbl()), + var_map(), [icode_lbl()]) + -> {state(), [icode_lbl()]}. + update_maps(State, From, [To|Left], Map, Acc) -> case state__map_update(State, From, To, Map) of fixpoint -> @@ -198,10 +252,13 @@ update_maps(State, From, [To|Left], Map, Acc) -> update_maps(State, _From, [], _Map, Acc) -> {State, Acc}. +-spec transform_instrs(icode_instrs(), edge_map(), var_map(), icode_instrs()) + -> {var_map(), icode_instrs()}. + transform_instrs([I|Left], PhiMap, Map, Acc) -> Defines = hipe_icode:defines(I), - NewMap = delete_all(Defines, Map), - NewPhiMap = delete_all(Defines, PhiMap), + NewMap = maps:without(Defines, Map), + NewPhiMap = maps:without(Defines, PhiMap), case I of #icode_phi{} -> Uses = hipe_icode:uses(I), @@ -213,7 +270,7 @@ transform_instrs([I|Left], PhiMap, Map, Acc) -> %% All arguments are untagged. Let's untag the destination. Dst = hipe_icode:phi_dst(I), NewDst = hipe_icode:mk_new_fvar(), - NewMap1 = gb_trees:enter(Dst, NewDst, NewMap), + NewMap1 = NewMap#{Dst => NewDst}, NewI = subst_phi_uncond(I, NewDst, PhiMap), transform_instrs(Left, NewPhiMap, NewMap1, [NewI|Acc]); _ -> @@ -232,7 +289,7 @@ transform_instrs([I|Left], PhiMap, Map, Acc) -> [Src] -> case lookup(Src, Map) of none -> - NewMap1 = gb_trees:enter(Src, {assigned, Dst}, NewMap), + NewMap1 = NewMap#{Src => {assigned, Dst}}, transform_instrs(Left, NewPhiMap, NewMap1, [I|Acc]); Dst -> %% This is the instruction that untagged the variable. @@ -255,7 +312,7 @@ transform_instrs([I|Left], PhiMap, Map, Acc) -> unsafe_tag_float -> [Dst] = hipe_icode:defines(I), [Src] = hipe_icode:uses(I), - NewMap1 = gb_trees:enter(Dst, {assigned, Src}, NewMap), + NewMap1 = NewMap#{Dst => {assigned, Src}}, transform_instrs(Left, NewPhiMap, NewMap1,[I|Acc]); _ -> {NewMap1, NewAcc} = check_for_fop_candidates(I, NewMap, Acc), @@ -268,6 +325,9 @@ transform_instrs([I|Left], PhiMap, Map, Acc) -> transform_instrs([], _PhiMap, Map, Acc) -> {Map, lists:reverse(Acc)}. +-spec check_for_fop_candidates(icode_instr(), var_map(), icode_instrs()) + -> {var_map(), icode_instrs()}. + check_for_fop_candidates(I, Map, Acc) -> case is_fop_cand(I) of false -> @@ -310,6 +370,8 @@ check_for_fop_candidates(I, Map, Acc) -> end. +-spec handle_untagged_arguments(icode_instr(), var_map()) -> icode_instrs(). + %% If this is an instruction that needs to operate on tagged values, %% which currently are untagged, we must tag the values and perhaps %% end the fp ebb. @@ -321,23 +383,24 @@ handle_untagged_arguments(I, Map) -> Tag -> TagIntrs = [hipe_icode:mk_primop([Dst], unsafe_tag_float, - [gb_trees:get(Dst, Map)]) || Dst <- Tag], + [maps:get(Dst, Map)]) || Dst <- Tag], [I|TagIntrs] end. +-spec do_prelude(var_map_phi()) -> {[icode_phi()], var_map()}. + %% Add phi nodes for untagged fp values. -do_prelude(Map) -> - case gb_trees:lookup(phi, Map) of - none -> - {[], Map}; - {value, List} -> - %%io:format("Adding phi: ~w\n", [List]), - Fun = fun ({FVar, Bindings}, Acc) -> - [hipe_icode:mk_phi(FVar, Bindings)|Acc] - end, - {lists:foldl(Fun, [], List), gb_trees:delete(phi, Map)} - end. +do_prelude(Map = #{phi := List}) -> + %%io:format("Adding phi: ~w\n", [List]), + Fun = fun ({FVar, Bindings}, Acc) -> + [hipe_icode:mk_phi(FVar, Bindings)|Acc] + end, + {lists:foldl(Fun, [], List), maps:remove(phi, Map)}; +do_prelude(Map) -> {[], Map}. + +-spec split_code([I]) -> {[I], I} when + I :: icode_instr(). split_code(Code) -> split_code(Code, []). @@ -348,6 +411,8 @@ split_code([I|Left], Acc) -> split_code(Left, [I|Acc]). +-spec finalize(state()) -> state(). + %% When all code is mapped to fp instructions we must make sure that %% the fp ebb information going into each block is the same as the %% information coming out of each predecessor. Otherwise, we must add @@ -359,17 +424,25 @@ finalize(State) -> Edges = needs_fcheckerror(NewState), finalize(Edges, NewState). +-spec finalize([edge()], state()) -> state(). + finalize([{From, To}|Left], State) -> NewState = add_fp_ebb_fixup(From, To, State), finalize(Left, NewState); finalize([], State) -> State. +-spec needs_fcheckerror(state()) -> [{none | icode_lbl(), icode_lbl()}]. + needs_fcheckerror(State) -> Cfg = state__cfg(State), Labels = hipe_icode_cfg:labels(Cfg), needs_fcheckerror(Labels, State, []). +-spec needs_fcheckerror([icode_lbl()], state(), + [{none | icode_lbl(), icode_lbl()}]) + -> [{none | icode_lbl(), icode_lbl()}]. + needs_fcheckerror([Label|Left], State, Acc) -> case state__get_in_block_in(State, Label) of {true, _} -> @@ -394,6 +467,8 @@ needs_fcheckerror([Label|Left], State, Acc) -> needs_fcheckerror([], _State, Acc) -> Acc. +-spec add_fp_ebb_fixup(none | icode_lbl(), icode_lbl(), state()) -> state(). + add_fp_ebb_fixup('none', To, State) -> %% Add the fcheckerror to the start of the block. BB = state__bb(State, To), @@ -415,27 +490,40 @@ add_fp_ebb_fixup(From, To, State) -> NewToBB = hipe_bb:code_update(ToBB, NewToCode), state__bb_add(NewState1, To, NewToBB). +-spec redirect_phis(icode_instrs(), icode_lbl(), icode_lbl()) + -> icode_instrs(). + redirect_phis(Code, OldFrom, NewFrom) -> redirect_phis(Code, OldFrom, NewFrom, []). +-spec redirect_phis(icode_instrs(), icode_lbl(), icode_lbl(), icode_instrs()) + -> icode_instrs(). + redirect_phis([I|Is] = Code, OldFrom, NewFrom, Acc) -> case I of #icode_phi{} -> NewI = hipe_icode:phi_redirect_pred(I, OldFrom, NewFrom), redirect_phis(Is, OldFrom, NewFrom, [NewI|Acc]); _ -> - lists:reverse(Acc) ++ Code + lists:reverse(Acc, Code) end; redirect_phis([], _OldFrom, _NewFrom, Acc) -> lists:reverse(Acc). +-spec subst_phi(icode_phi(), icode_variable(), edge_map()) + -> icode_phi(). + subst_phi(I, Dst, Map) -> ArgList = subst_phi_uses0(hipe_icode:phi_arglist(I), Map, []), hipe_icode:mk_phi(Dst, ArgList). +-spec subst_phi_uses0([{icode_lbl(), icode_variable()}], edge_map(), + [{icode_lbl(), icode_variable()}]) + -> [{icode_lbl(), icode_variable()}]. + subst_phi_uses0([{Pred, Var}|Left], Map, Acc) -> - case gb_trees:lookup(Var, Map) of - {value, List} -> + case Map of + #{Var := List} -> case lists:keyfind(Pred, 1, List) of {Pred, {assigned, _NewVar}} -> %% The variable is untagged, but it has been assigned. Keep it! @@ -447,20 +535,27 @@ subst_phi_uses0([{Pred, Var}|Left], Map, Acc) -> %% The variable is not untagged. subst_phi_uses0(Left, Map, [{Pred, Var} | Acc]) end; - none -> + #{} -> %% The variable is not untagged. subst_phi_uses0(Left, Map, [{Pred, Var} | Acc]) end; subst_phi_uses0([], _Map, Acc) -> Acc. +-spec subst_phi_uncond(icode_phi(), icode_variable(), edge_map()) + -> icode_phi(). + subst_phi_uncond(I, Dst, Map) -> ArgList = subst_phi_uses_uncond0(hipe_icode:phi_arglist(I), Map, []), hipe_icode:mk_phi(Dst, ArgList). +-spec subst_phi_uses_uncond0([{icode_lbl(), icode_variable()}], edge_map(), + [{icode_lbl(), icode_variable()}]) + -> [{icode_lbl(), icode_variable()}]. + subst_phi_uses_uncond0([{Pred, Var}|Left], Map, Acc) -> - case gb_trees:lookup(Var, Map) of - {value, List} -> + case Map of + #{Var := List} -> case lists:keyfind(Pred, 1, List) of {Pred, {assigned, NewVar}} -> %% The variable is untagged! @@ -472,13 +567,15 @@ subst_phi_uses_uncond0([{Pred, Var}|Left], Map, Acc) -> %% The variable is not untagged. subst_phi_uses_uncond0(Left, Map, [{Pred, Var} | Acc]) end; - none -> + #{} -> %% The variable is not untagged. subst_phi_uses_uncond0(Left, Map, [{Pred, Var} | Acc]) end; subst_phi_uses_uncond0([], _Map, Acc) -> Acc. +-spec place_error_handling(worklist(), state()) -> state(). + place_error_handling(WorkList, State) -> case get_work(WorkList) of none -> @@ -501,6 +598,9 @@ place_error_handling(WorkList, State) -> end end. +-spec place_error(icode_instrs(), in_block(), icode_instrs()) + -> {icode_instrs(), in_block()}. + place_error([I|Left], InBlock, Acc) -> case I of #icode_call{} -> @@ -637,12 +737,10 @@ instr_allowed_in_fp_ebb(Instr) -> %%============================================================= %% ------------------------------------------------------------ -%% Handling the gb_tree +%% Handling the variable map -delete_all([Key|Left], Tree) -> - delete_all(Left, gb_trees:delete_any(Key, Tree)); -delete_all([], Tree) -> - Tree. +-spec lookup_list([icode_var() | icode_const()], var_map()) + -> [none | icode_fvar()]. lookup_list(List, Info) -> lookup_list(List, fun lookup/2, Info, []). @@ -652,33 +750,43 @@ lookup_list([H|T], Fun, Info, Acc) -> lookup_list([], _, _, Acc) -> lists:reverse(Acc). +-spec lookup(icode_var() | icode_const(), var_map()) -> none | icode_fvar(). + lookup(Key, Tree) -> case hipe_icode:is_const(Key) of %% This can be true if the same constant has been %% untagged more than once true -> none; false -> - case gb_trees:lookup(Key, Tree) of - none -> none; - {value, {assigned, Val}} -> Val; - {value, Val} -> Val + case Tree of + #{Key := {assigned, Val}} -> Val; + #{Key := Val} -> Val; + #{} -> none end end. +-spec lookup_list_keep_consts([icode_var() | icode_const()], var_map()) + -> [none | icode_fvar() | icode_const()]. + lookup_list_keep_consts(List, Info) -> lookup_list(List, fun lookup_keep_consts/2, Info, []). +-spec lookup_keep_consts(icode_var() | icode_const(), var_map()) + -> none | icode_fvar() | icode_const(). + lookup_keep_consts(Key, Tree) -> case hipe_icode:is_const(Key) of true -> Key; false -> - case gb_trees:lookup(Key, Tree) of - none -> none; - {value, {assigned, Val}} -> Val; - {value, Val} -> Val + case Tree of + #{Key := {assigned, Val}} -> Val; + #{Key := Val} -> Val; + #{} -> none end end. +-spec get_type(icode_argument()) -> erl_types:erl_type(). + get_type(Var) -> case hipe_icode:is_const(Var) of true -> erl_types:t_from_term(hipe_icode:const_value(Var)); @@ -694,98 +802,108 @@ get_type(Var) -> %% ------------------------------------------------------------ %% Handling the map from variables to fp-variables +-spec join_maps([edge()], edge_map()) -> initial_var_map(). + join_maps(Edges, EdgeMap) -> - join_maps(Edges, EdgeMap, gb_trees:empty()). + join_maps(Edges, EdgeMap, #{}). join_maps([Edge = {Pred, _}|Left], EdgeMap, Map) -> - case gb_trees:lookup(Edge, EdgeMap) of - none -> + case EdgeMap of + #{Edge := OldMap} -> + NewMap = join_maps0(maps:to_list(OldMap), Pred, Map), + join_maps(Left, EdgeMap, NewMap); + #{} -> %% All predecessors have not been handled. Use empty map. - gb_trees:empty(); - {value, OldMap} -> - NewMap = join_maps0(gb_trees:to_list(OldMap), Pred, Map), - join_maps(Left, EdgeMap, NewMap) + #{} end; join_maps([], _, Map) -> Map. -join_maps0([{phi, _}|Tail], Pred, Map) -> - join_maps0(Tail, Pred, Map); -join_maps0([{Var, FVar}|Tail], Pred, Map) -> - case gb_trees:lookup(Var, Map) of - none -> - join_maps0(Tail, Pred, gb_trees:enter(Var, [{Pred, FVar}], Map)); - {value, List} -> +-spec join_maps0(list(), icode_lbl(), initial_var_map()) -> initial_var_map(). + +join_maps0([{Var=#icode_variable{kind=var}, FVar}|Tail], Pred, Map) -> + case Map of + #{Var := List} -> case lists:keyfind(Pred, 1, List) of false -> - join_maps0(Tail, Pred, gb_trees:update(Var, [{Pred, FVar}|List], Map)); + join_maps0(Tail, Pred, Map#{Var := [{Pred, FVar}|List]}); {Pred, FVar} -> %% No problem. join_maps0(Tail, Pred, Map); _ -> exit('New binding to same variable') - end + end; + #{} -> + join_maps0(Tail, Pred, Map#{Var => [{Pred, FVar}]}) end; join_maps0([], _, Map) -> Map. +-spec filter_map(initial_var_map(), pos_integer()) -> var_map_phi(). + filter_map(Map, NofPreds) -> - filter_map(gb_trees:to_list(Map), NofPreds, Map). + filter_map(maps:to_list(Map), NofPreds, Map). + +-spec filter_map([{icode_var(), incoming_fvars()}], pos_integer(), + var_map_phi()) -> var_map_phi(). filter_map([{Var, Bindings}|Left], NofPreds, Map) -> case length(Bindings) =:= NofPreds of true -> + BindingsAllAssigned = lists:all(fun({_, {assigned, _}}) -> true; + ({_, _}) -> false + end, Bindings), case all_args_equal(Bindings) of true -> - {_, FVar} = hd(Bindings), - filter_map(Left, NofPreds, gb_trees:update(Var, FVar, Map)); + NewBinding = + case hd(Bindings) of + {Pred, {assigned, FVar0}} when is_integer(Pred) -> + case BindingsAllAssigned of + true -> {assigned, FVar0}; + false -> FVar0 + end; + {Pred, FVar0} when is_integer(Pred) -> FVar0 + end, + filter_map(Left, NofPreds, Map#{Var := NewBinding}); false -> PhiDst = hipe_icode:mk_new_fvar(), PhiArgs = strip_of_assigned(Bindings), NewMap = - case gb_trees:lookup(phi, Map) of - none -> - gb_trees:insert(phi, [{PhiDst, PhiArgs}], Map); - {value, Val} -> - gb_trees:update(phi, [{PhiDst, PhiArgs}|Val], Map) + case Map of + #{phi := Val} -> + Map#{phi := [{PhiDst, PhiArgs}|Val]}; + #{} -> + Map#{phi => [{PhiDst, PhiArgs}]} end, NewBinding = - case bindings_are_assigned(Bindings) of + case BindingsAllAssigned of true -> {assigned, PhiDst}; false -> PhiDst end, - filter_map(Left, NofPreds, gb_trees:update(Var, NewBinding, NewMap)) + filter_map(Left, NofPreds, NewMap#{Var := NewBinding}) end; false -> - filter_map(Left, NofPreds, gb_trees:delete(Var, Map)) + filter_map(Left, NofPreds, maps:remove(Var, Map)) end; filter_map([], _NofPreds, Map) -> Map. -bindings_are_assigned([{_, {assigned, _}}|Left]) -> - assert_assigned(Left), - true; -bindings_are_assigned(Bindings) -> - assert_not_assigned(Bindings), - false. - -assert_assigned([{_, {assigned, _}}|Left]) -> - assert_assigned(Left); -assert_assigned([]) -> - ok. - -assert_not_assigned([{_, FVar}|Left]) -> - true = hipe_icode:is_fvar(FVar), - assert_not_assigned(Left); -assert_not_assigned([]) -> - ok. +-spec all_args_equal(incoming_fvars()) -> boolean(). %% all_args_equal returns true if the mapping for a variable is the %% same from all predecessors, i.e., we do not need a phi-node. +%% During the fixpoint loop, a mapping might become assigned, without that +%% information having propagated into all predecessors. We take care to answer +%% true even if FVar is only assigned in some predecessors. + +all_args_equal([{_, {assigned, FVar}}|Left]) -> + all_args_equal(Left, FVar); all_args_equal([{_, FVar}|Left]) -> all_args_equal(Left, FVar). +all_args_equal([{_, {assigned, FVar1}}|Left], FVar1) -> + all_args_equal(Left, FVar1); all_args_equal([{_, FVar1}|Left], FVar1) -> all_args_equal(Left, FVar1); all_args_equal([], _) -> @@ -794,20 +912,24 @@ all_args_equal(_, _) -> false. +-spec add_new_bindings_unassigned([icode_var()], var_map()) -> var_map(). + %% We differentiate between values that have been assigned as %% tagged variables and those that got a 'virtual' binding. add_new_bindings_unassigned([Var|Left], Map) -> FVar = hipe_icode:mk_new_fvar(), - add_new_bindings_unassigned(Left, gb_trees:insert(Var, FVar, Map)); + add_new_bindings_unassigned(Left, Map#{Var => FVar}); add_new_bindings_unassigned([], Map) -> Map. +-spec add_new_bindings_assigned([icode_var()], var_map()) -> var_map(). + add_new_bindings_assigned([Var|Left], Map) -> case lookup(Var, Map) of none -> FVar = hipe_icode:mk_new_fvar(), - NewMap = gb_trees:insert(Var, {assigned, FVar}, Map), + NewMap = Map#{Var => {assigned, FVar}}, add_new_bindings_assigned(Left, NewMap); _ -> add_new_bindings_assigned(Left, Map) @@ -815,6 +937,8 @@ add_new_bindings_assigned([Var|Left], Map) -> add_new_bindings_assigned([], Map) -> Map. +-spec strip_of_assigned(incoming_fvars()) -> [{icode_lbl(), icode_fvar()}]. + strip_of_assigned(List) -> strip_of_assigned(List, []). @@ -829,6 +953,8 @@ strip_of_assigned([], Acc) -> %% Help functions for the transformation from ordinary instruction to %% fp-instruction +-spec is_fop_cand(icode_instr()) -> boolean(). + is_fop_cand(I) -> case hipe_icode:call_fun(I) of '/' -> true; @@ -839,6 +965,8 @@ is_fop_cand(I) -> end end. +-spec any_is_float([icode_argument()]) -> boolean(). + any_is_float(Vars) -> lists:any(fun (V) -> erl_types:t_is_float(get_type(V)) end, Vars). @@ -865,25 +993,32 @@ fun_to_fop(Fun) -> end. +-spec must_be_tagged(icode_var(), var_map()) -> boolean(). + %% If there is a tagged version of this variable available we don't %% have to tag the untagged version. must_be_tagged(Var, Map) -> - case gb_trees:lookup(Var, Map) of - none -> false; - {value, {assigned, _}} -> false; - {value, Val} -> hipe_icode:is_fvar(Val) + case Map of + #{Var := {assigned, _}} -> false; + #{Var := Val} -> hipe_icode:is_fvar(Val); + #{} -> false end. +-spec get_conv_instrs([icode_argument()], var_map()) -> icode_instrs(). + %% Converting to floating point variables get_conv_instrs(Vars, Map) -> get_conv_instrs(Vars, Map, []). +-spec get_conv_instrs([icode_argument()], var_map(), icode_instrs()) + -> icode_instrs(). + get_conv_instrs([Var|Left], Map, Acc) -> - {_, Dst} = gb_trees:get(Var, Map), - NewI = + #{Var := {_, Dst}} = Map, + NewI = case erl_types:t_is_float(get_type(Var)) of true -> [hipe_icode:mk_primop([Dst], unsafe_untag_float, [Var])]; @@ -895,6 +1030,8 @@ get_conv_instrs([], _, Acc) -> Acc. +-spec conv_consts([icode_const()], icode_instr()) -> icode_instr(). + conv_consts(ConstArgs, I) -> conv_consts(ConstArgs, I, []). @@ -933,63 +1070,79 @@ state__bb_add(S = #state{cfg = Cfg}, Label, BB) -> NewCfg = hipe_icode_cfg:bb_add(Cfg, Label, BB), S#state{cfg = NewCfg}. +-spec state__map(state(), icode_lbl()) -> initial_var_map(). + state__map(S = #state{edge_map = EM}, To) -> join_maps([{From, To} || From <- state__pred(S, To)], EM). +-spec state__map_update(state(), icode_lbl(), icode_lbl(), var_map()) -> + fixpoint | state(). + state__map_update(S = #state{edge_map = EM}, From, To, Map) -> FromTo = {From, To}, MapChanged = - case gb_trees:lookup(FromTo, EM) of - {value, Map1} -> not match(Map1, Map); - none -> true + case EM of + #{FromTo := Map1} -> not match(Map1, Map); + #{} -> true end, case MapChanged of true -> - NewEM = gb_trees:enter(FromTo, Map, EM), + NewEM = EM#{FromTo => Map}, S#state{edge_map = NewEM}; false -> fixpoint end. +-spec state__join_in_block(state(), icode_lbl()) + -> fixpoint | {state(), in_block()}. + state__join_in_block(S = #state{fp_ebb_map = Map}, Label) -> Pred = state__pred(S, Label), Edges = [{X, Label} || X <- Pred], - NewInBlock = join_in_block([gb_trees:lookup(X, Map) || X <- Edges]), + NewInBlock = join_in_block([maps:find(X, Map) || X <- Edges]), InBlockLabel = {inblock_in, Label}, - case gb_trees:lookup(InBlockLabel, Map) of - none -> - NewMap = gb_trees:insert(InBlockLabel, NewInBlock, Map), - {S#state{fp_ebb_map = NewMap}, NewInBlock}; - {value, NewInBlock} -> + case Map of + #{InBlockLabel := NewInBlock} -> fixpoint; - _Other -> - NewMap = gb_trees:update(InBlockLabel, NewInBlock, Map), + _ -> + NewMap = Map#{InBlockLabel => NewInBlock}, {S#state{fp_ebb_map = NewMap}, NewInBlock} end. +-spec state__in_block_out_update(state(), icode_lbl(), in_block()) + -> state(). + state__in_block_out_update(S = #state{fp_ebb_map = Map}, Label, NewInBlock) -> Succ = state__succ(S, Label), Edges = [{Label, X} || X <- Succ], NewMap = update_edges(Edges, NewInBlock, Map), - NewMap1 = gb_trees:enter({inblock_out, Label}, NewInBlock, NewMap), + NewMap1 = NewMap#{{inblock_out, Label} => NewInBlock}, S#state{fp_ebb_map = NewMap1}. +-spec update_edges([edge()], in_block(), fp_ebb_map()) -> fp_ebb_map(). + update_edges([Edge|Left], NewInBlock, Map) -> - NewMap = gb_trees:enter(Edge, NewInBlock, Map), + NewMap = Map#{Edge => NewInBlock}, update_edges(Left, NewInBlock, NewMap); update_edges([], _NewInBlock, NewMap) -> NewMap. +-spec join_in_block([error | {ok, in_block()}]) -> in_block(). + join_in_block([]) -> false; -join_in_block([none|_]) -> +join_in_block([error|_]) -> false; -join_in_block([{value, InBlock}|Left]) -> +join_in_block([{ok, InBlock}|Left]) -> join_in_block(Left, InBlock). -join_in_block([none|_], _Current) -> +-spec join_in_block([error | {ok, in_block()}], Current) + -> false | Current when + Current :: in_block(). + +join_in_block([error|_], _Current) -> false; -join_in_block([{value, InBlock}|Left], Current) -> +join_in_block([{ok, InBlock}|Left], Current) -> if Current =:= InBlock -> join_in_block(Left, Current); Current =:= false -> false; InBlock =:= false -> false; @@ -997,19 +1150,25 @@ join_in_block([{value, InBlock}|Left], Current) -> end; join_in_block([], Current) -> Current. - + + +-spec state__get_in_block_in(state(), icode_lbl()) -> in_block(). state__get_in_block_in(#state{fp_ebb_map = Map}, Label) -> - gb_trees:get({inblock_in, Label}, Map). + maps:get({inblock_in, Label}, Map). state__get_in_block_out(#state{fp_ebb_map = Map}, Label) -> - gb_trees:get({inblock_out, Label}, Map). + maps:get({inblock_out, Label}, Map). +-spec new_worklist(state()) -> worklist(). + new_worklist(#state{cfg = Cfg}) -> Start = hipe_icode_cfg:start_label(Cfg), {[Start], [], gb_sets:insert(Start, gb_sets:empty())}. +-spec get_work(worklist()) -> none | {icode_lbl(), worklist()}. + get_work({[Label|Left], List, Set}) -> {Label, {Left, List, gb_sets:delete(Label, Set)}}; get_work({[], [], _Set}) -> @@ -1017,6 +1176,8 @@ get_work({[], [], _Set}) -> get_work({[], List, Set}) -> get_work({lists:reverse(List), [], Set}). +-spec add_work(worklist(), [icode_lbl()]) -> worklist(). + add_work({List1, List2, Set} = Work, [Label|Left]) -> case gb_sets:is_member(Label, Set) of true -> @@ -1029,15 +1190,7 @@ add_work({List1, List2, Set} = Work, [Label|Left]) -> add_work(WorkList, []) -> WorkList. -match(Tree1, Tree2) -> - match_1(gb_trees:to_list(Tree1), Tree2) andalso - match_1(gb_trees:to_list(Tree2), Tree1). +-spec match(var_map(), var_map()) -> boolean(). -match_1([{Key, Val}|Left], Tree2) -> - case gb_trees:lookup(Key, Tree2) of - {value, Val} -> - match_1(Left, Tree2); - _ -> false - end; -match_1([], _) -> - true. +match(Tree1, Tree2) when is_map(Tree1), is_map(Tree2) -> + Tree1 =:= Tree2. diff --git a/lib/hipe/icode/hipe_icode_heap_test.erl b/lib/hipe/icode/hipe_icode_heap_test.erl index 92d5f023fa..ec754d5ee9 100644 --- a/lib/hipe/icode/hipe_icode_heap_test.erl +++ b/lib/hipe/icode/hipe_icode_heap_test.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/icode/hipe_icode_inline_bifs.erl b/lib/hipe/icode/hipe_icode_inline_bifs.erl index 6ef15b9a18..79f67c2db6 100644 --- a/lib/hipe/icode/hipe_icode_inline_bifs.erl +++ b/lib/hipe/icode/hipe_icode_inline_bifs.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2012. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/icode/hipe_icode_instruction_counter.erl b/lib/hipe/icode/hipe_icode_instruction_counter.erl index 92658d294a..afa70e495b 100644 --- a/lib/hipe/icode/hipe_icode_instruction_counter.erl +++ b/lib/hipe/icode/hipe_icode_instruction_counter.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2009. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -64,7 +65,8 @@ walktrough_bb(BB, Info) -> %% The counter specific functions %%------------------------------------------------------------------- --spec compare(gb_tree(), gb_tree(), gb_tree()) -> gb_tree(). +-spec compare(gb_trees:tree(), gb_trees:tree(), gb_trees:tree()) -> + gb_trees:tree(). compare(Name, Old, New) -> NewList = gb_trees:to_list(New), diff --git a/lib/hipe/icode/hipe_icode_liveness.erl b/lib/hipe/icode/hipe_icode_liveness.erl index 5816e59032..317d2e54c2 100644 --- a/lib/hipe/icode/hipe_icode_liveness.erl +++ b/lib/hipe/icode/hipe_icode_liveness.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/icode/hipe_icode_mulret.erl b/lib/hipe/icode/hipe_icode_mulret.erl index 0bf9f89994..d927a46222 100644 --- a/lib/hipe/icode/hipe_icode_mulret.erl +++ b/lib/hipe/icode/hipe_icode_mulret.erl @@ -1,19 +1,20 @@ -%% -*- coding: utf-8; erlang-indent-level: 2 -*- +%% -*- erlang-indent-level: 2 -*- %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2012. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -1166,9 +1167,9 @@ printCallList([]) -> io:format("~n"). %% removeUnElems([#icode_call{'fun'={unsafe_element,_}, args=Var}|List], Var, Res) -> %% removeUnElems(List, Var, Res); %% removeUnElems([I=#icode_move{dst=Var}|List], [Var], Res) -> -%% lists:reverse(Res) ++ [I|List]; +%% lists:reverse(Res, [I|List]); %% removeUnElems([I=#icode_call{dstlist=Var}|List], Var, Res) -> -%% lists:reverse(Res) ++ [I|List]; +%% lists:reverse(Res, [I|List]); %% removeUnElems([I|List], Var, Res) -> %% removeUnElems(List, Var, [I|Res]); %% removeUnElems([], _, Res) -> lists:reverse(Res). @@ -1187,7 +1188,7 @@ printCallList([]) -> io:format("~n"). %% false -> %% case lists:member(Var, Defs) of %% true -> -%% lists:reverse(Res) ++ [I|List]; +%% lists:reverse(Res, [I|List]); %% false -> %% removeUnElems(List, Var, [I|Res]) %% end @@ -1195,7 +1196,7 @@ printCallList([]) -> io:format("~n"). %% false -> %% case lists:member(Var, Defs) of %% true -> -%% lists:reverse(Res) ++ [I|List]; +%% lists:reverse(Res, [I|List]); %% false -> %% removeUnElems(List, Var, [I|Res]) %% end @@ -1203,7 +1204,7 @@ printCallList([]) -> io:format("~n"). %% false -> %% case lists:member(Var, Defs) of %% true -> -%% lists:reverse(Res) ++ [I|List]; +%% lists:reverse(Res, [I|List]); %% false -> %% removeUnElems(List, Var, [I|Res]) %% end @@ -1248,16 +1249,16 @@ printCallList([]) -> io:format("~n"). %% modifyCode([I|Code], Var, Res) -> %% case scanInstr(I, Var) of %% {move, Arity, VarLst} -> -%% Code2 = [#icode_return{vars=VarLst}, I |lists:reverse(Res) ++ Code], +%% Code2 = [#icode_return{vars=VarLst}, I |lists:reverse(Res, Code)], %% {Arity, lists:reverse(Code2)}; %% {mktuple, Arity, VarLst} -> -%% Code2 = [#icode_return{vars=VarLst}|lists:reverse(Res) ++ Code], +%% Code2 = [#icode_return{vars=VarLst}|lists:reverse(Res, Code)], %% {Arity, lists:reverse(Code2)}; %% other -> %% modifyCode(Code, Var, [I|Res]) %% end; %% modifyCode([], Var, Res) -> -%% {1, lists:reverse(Res) ++ [#icode_return{vars=Var}]}. +%% {1, lists:reverse(Res, [#icode_return{vars=Var}]}. %% scanInstr(#icode_call{dstlist=Var, 'fun'=mktuple, args=Lst}, Var) -> %% {mktuple, length(Lst), Lst}; diff --git a/lib/hipe/icode/hipe_icode_pp.erl b/lib/hipe/icode/hipe_icode_pp.erl index de29b6f779..a736b54c38 100644 --- a/lib/hipe/icode/hipe_icode_pp.erl +++ b/lib/hipe/icode/hipe_icode_pp.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2011. All Rights Reserved. +%% Copyright Ericsson AB 2003-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/icode/hipe_icode_primops.erl b/lib/hipe/icode/hipe_icode_primops.erl index b0113fc556..cee37b6a57 100644 --- a/lib/hipe/icode/hipe_icode_primops.erl +++ b/lib/hipe/icode/hipe_icode_primops.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2011. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -115,7 +116,7 @@ is_safe({hipe_bs_primop, {bs_init, _, _}}) -> false; is_safe({hipe_bs_primop, {bs_init_bits, _}}) -> false; is_safe({hipe_bs_primop, {bs_init_bits, _, _}}) -> false; is_safe({hipe_bs_primop, {bs_put_binary, _, _}}) -> false; -is_safe({hipe_bs_primop, {bs_put_binary_all, _}}) -> false; +is_safe({hipe_bs_primop, {bs_put_binary_all, _, _}}) -> false; is_safe({hipe_bs_primop, {bs_put_float, _, _, _}}) -> false; is_safe({hipe_bs_primop, {bs_put_integer, _, _, _}}) -> false; is_safe({hipe_bs_primop, {bs_put_string, _, _}}) -> false; @@ -218,7 +219,7 @@ fails({hipe_bs_primop, {bs_init, _, _}}) -> true; fails({hipe_bs_primop, {bs_init_bits, _}}) -> true; fails({hipe_bs_primop, {bs_init_bits, _, _}}) -> true; fails({hipe_bs_primop, {bs_put_binary, _, _}}) -> true; -fails({hipe_bs_primop, {bs_put_binary_all, _}}) -> true; +fails({hipe_bs_primop, {bs_put_binary_all, _, _}}) -> true; fails({hipe_bs_primop, {bs_put_float, _, _, _}}) -> true; fails({hipe_bs_primop, {bs_put_integer, _, _, _}}) -> true; fails({hipe_bs_primop, {bs_put_string, _, _}}) -> true; @@ -264,8 +265,8 @@ pp(Dev, Op) -> io:format(Dev, "gc_test<~w>", [N]); {hipe_bs_primop, BsOp} -> case BsOp of - {bs_put_binary_all, Flags} -> - io:format(Dev, "bs_put_binary_all<~w>", [Flags]); + {bs_put_binary_all, Unit, Flags} -> + io:format(Dev, "bs_put_binary_all<~w, ~w>", [Unit,Flags]); {bs_put_binary, Size} -> io:format(Dev, "bs_put_binary<~w>", [Size]); {bs_put_binary, Flags, Size} -> @@ -503,14 +504,16 @@ type(Primop, Args) -> NewBinType = match_bin(erl_types:t_bitstr(0, Size), BinType), NewMatchState = erl_types:t_matchstate_update_present(NewBinType, MatchState), - if Signed =:= 0 -> - erl_types:t_product([erl_types:t_from_range(0, 1 bsl Size - 1), - NewMatchState]); - Signed =:= 4 -> - erl_types:t_product([erl_types:t_from_range(- (1 bsl (Size-1)), - (1 bsl (Size-1)) - 1), - NewMatchState]) - end; + Range = + case Signed of + 0 -> + UpperBound = inf_add(safe_bsl_1(Size), -1), + erl_types:t_from_range(0, UpperBound); + 4 -> + Bound = safe_bsl_1(Size - 1), + erl_types:t_from_range(inf_inv(Bound), inf_add(Bound, -1)) + end, + erl_types:t_product([Range, NewMatchState]); [_Arg] -> NewBinType = match_bin(erl_types:t_bitstr(Size, 0), BinType), NewMatchState = @@ -627,8 +630,9 @@ type(Primop, Args) -> [_SrcType, _BitsType, _Base, Type] -> erl_types:t_bitstr_concat(Type, erl_types:t_bitstr(Size, 0)) end; - {hipe_bs_primop, {bs_put_binary_all, _Flags}} -> - [SrcType, _Base, Type] = Args, + {hipe_bs_primop, {bs_put_binary_all, Unit, _Flags}} -> + [SrcType0, _Base, Type] = Args, + SrcType = erl_types:t_inf(erl_types:t_bitstr(Unit, 0), SrcType0), erl_types:t_bitstr_concat(SrcType,Type); {hipe_bs_primop, {bs_put_string, _, Size}} -> [_Base, Type] = Args, @@ -964,3 +968,20 @@ check_fun_args(_, _) -> match_bin(Pattern, Match) -> erl_types:t_bitstr_match(Pattern, Match). + +-spec safe_bsl_1(non_neg_integer()) -> non_neg_integer() | 'pos_inf'. + +safe_bsl_1(Shift) when Shift =< 128 -> 1 bsl Shift; +safe_bsl_1(_Shift) -> pos_inf. + +%% +%% The following two functions are stripped-down versions of more +%% general functions that exist in hipe_icode_range.erl +%% + +inf_inv(pos_inf) -> neg_inf; +inf_inv(Number) when is_integer(Number) -> -Number. + +inf_add(pos_inf, _Number) -> pos_inf; +inf_add(Number1, Number2) when is_integer(Number1), is_integer(Number2) -> + Number1 + Number2. diff --git a/lib/hipe/icode/hipe_icode_primops.hrl b/lib/hipe/icode/hipe_icode_primops.hrl index 8a65c5ece0..a0aee165ba 100644 --- a/lib/hipe/icode/hipe_icode_primops.hrl +++ b/lib/hipe/icode/hipe_icode_primops.hrl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/icode/hipe_icode_range.erl b/lib/hipe/icode/hipe_icode_range.erl index 1a2cbfae31..12ed796690 100644 --- a/lib/hipe/icode/hipe_icode_range.erl +++ b/lib/hipe/icode/hipe_icode_range.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -72,8 +73,8 @@ -type final_fun() :: fun((mfa(), [range()]) -> 'ok'). -type data() :: {mfa(), args_fun(), call_fun(), final_fun()}. -type label() :: non_neg_integer(). --type info() :: gb_tree(). --type work_list() :: {[label()], [label()], set()}. +-type info() :: gb_trees:tree(). +-type work_list() :: {[label()], [label()], sets:set()}. -type variable() :: #icode_variable{}. -type annotated_variable() :: #icode_variable{}. -type argument() :: #icode_const{} | variable(). @@ -82,12 +83,13 @@ -type last_instr_return() :: {instr_split_info(), range()}. -record(state, {info_map = gb_trees:empty() :: info(), - counter = dict:new() :: dict(), + counter = dict:new() :: dict:dict(), cfg :: cfg(), - liveness = gb_trees:empty() :: gb_tree(), + liveness = gb_trees:empty() :: gb_trees:tree(), ret_type :: range(), lookup_fun :: call_fun(), result_action :: final_fun()}). +-type state() :: #state{}. -define(WIDEN, 1). @@ -171,7 +173,7 @@ analyse(Cfg, Data) -> catch throw:no_input -> ok end. --spec safe_analyse(cfg(), data()) -> #state{}. +-spec safe_analyse(cfg(), data()) -> state(). safe_analyse(CFG, Data={MFA,_,_,_}) -> State = state__init(CFG, Data), @@ -180,14 +182,14 @@ safe_analyse(CFG, Data={MFA,_,_,_}) -> (state__result_action(NewState))(MFA, [state__ret_type(NewState)]), NewState. --spec rewrite_blocks(#state{}) -> #state{}. +-spec rewrite_blocks(state()) -> state(). rewrite_blocks(State) -> CFG = state__cfg(State), Start = hipe_icode_cfg:start_label(CFG), rewrite_blocks([Start], State, [Start]). --spec rewrite_blocks([label()], #state{}, [label()]) -> #state{}. +-spec rewrite_blocks([label()], state(), [label()]) -> state(). rewrite_blocks([Next|Rest], State, Visited) -> Info = state__info_in(State, Next), @@ -200,7 +202,7 @@ rewrite_blocks([Next|Rest], State, Visited) -> rewrite_blocks([], State, _) -> State. --spec analyse_blocks(#state{}, work_list()) -> #state{}. +-spec analyse_blocks(state(), work_list()) -> state(). analyse_blocks(State, Work) -> case get_work(Work) of @@ -217,7 +219,7 @@ analyse_blocks(State, Work) -> analyse_blocks(NewState, NewWork2) end. --spec analyse_block(label(), info(), #state{}, boolean()) -> {#state{}, [label()]}. +-spec analyse_block(label(), info(), state(), boolean()) -> {state(), [label()]}. analyse_block(Label, Info, State, Rewrite) -> BB = state__bb(State, Label), @@ -611,36 +613,32 @@ analyse_if(If, Info, Rewrite) -> {#icode_goto{} | #icode_if{}, [{label(), info()}]}. analyse_sane_if(If, Info, [Arg1, Arg2], [Range1, Range2], Rewrite) -> - case normalize_name(hipe_icode:if_op(If)) of - '>' -> - {TrueRange2, TrueRange1, FalseRange2, FalseRange1} = - range_inequality_propagation(Range2, Range1); - '<' -> - {TrueRange1, TrueRange2, FalseRange1, FalseRange2} = - range_inequality_propagation(Range1, Range2); - '>=' -> - {FalseRange1, FalseRange2, TrueRange1, TrueRange2} = + {TrueRange1, TrueRange2, FalseRange1, FalseRange2} = + case normalize_name(hipe_icode:if_op(If)) of + '>' -> + {TR2, TR1, FR2, FR1} = range_inequality_propagation(Range2, Range1), + {TR1, TR2, FR1, FR2}; + '<' -> range_inequality_propagation(Range1, Range2); - '=<' -> - {FalseRange2, FalseRange1, TrueRange2, TrueRange1} = - range_inequality_propagation(Range2, Range1); - '=:=' -> - {TrueRange1, TrueRange2, FalseRange1, FalseRange2} = - range_equality_propagation(Range1, Range2); - '=/=' -> - {FalseRange1, FalseRange2, TrueRange1, TrueRange2} = - range_equality_propagation(Range1, Range2); - '==' -> - {TempTrueRange1, TempTrueRange2, FalseRange1, FalseRange2} = - range_equality_propagation(Range1, Range2), - TrueRange1 = set_other(TempTrueRange1, other(Range1)), - TrueRange2 = set_other(TempTrueRange2, other(Range2)); - '/=' -> - {TempFalseRange1, TempFalseRange2, TrueRange1, TrueRange2} = - range_equality_propagation(Range1, Range2), - FalseRange1 = set_other(TempFalseRange1, other(Range1)), - FalseRange2 = set_other(TempFalseRange2, other(Range2)) - end, + '>=' -> + {FR1, FR2, TR1, TR2} = range_inequality_propagation(Range1, Range2), + {TR1, TR2, FR1, FR2}; + '=<' -> + {FR2, FR1, TR2, TR1} = range_inequality_propagation(Range2, Range1), + {TR1, TR2, FR1, FR2}; + '=:=' -> + {TR1, TR2, FR1, FR2} = range_equality_propagation(Range1, Range2), + {TR1, TR2, FR1, FR2}; + '=/=' -> + {FR1, FR2, TR1, TR2} = range_equality_propagation(Range1, Range2), + {TR1, TR2, FR1, FR2}; + '==' -> + {TR1, TR2, FR1, FR2} = range_equality_propagation(Range1, Range2), + {set_other(TR1,other(Range1)), set_other(TR2,other(Range2)), FR1, FR2}; + '/=' -> + {FR1, FR2, TR1, TR2} = range_equality_propagation(Range1, Range2), + {TR1, TR2, set_other(FR1,other(Range1)), set_other(FR2,other(Range2))} + end, %% io:format("TR1 = ~w\nTR2 = ~w\n", [TrueRange1, TrueRange2]), True = case lists:all(fun range__is_none/1, [TrueRange1, TrueRange2]) of @@ -693,26 +691,24 @@ normalize_name(Name) -> -spec range_equality_propagation(range(), range()) -> {range(), range(), range(), range()}. -range_equality_propagation(Range_1, Range_2) -> - True_range = inf(Range_1, Range_2), - case {range(Range_1), range(Range_2)} of - {{N,N}, {N,N}} -> - False_range_1 = none_range(), - False_range_2 = none_range(); - {{N1,N1}, {N2,N2}} -> - False_range_1 = Range_1, - False_range_2 = Range_2; - {{N,N}, _} -> - False_range_1 = Range_1, - {_,False_range_2} = compare_with_integer(N, Range_2); - {_, {N,N}} -> - False_range_2 = Range_2, - {_,False_range_1} = compare_with_integer(N, Range_1); - {_, _} -> - False_range_1 = Range_1, - False_range_2 = Range_2 - end, - {True_range, True_range, False_range_1, False_range_2}. +range_equality_propagation(Range1, Range2) -> + TrueRange = inf(Range1, Range2), + {FalseRange1, FalseRange2} = + case {range(Range1), range(Range2)} of + {{N,N}, {N,N}} -> + {none_range(), none_range()}; + {{N1,N1}, {N2,N2}} -> + {Range1, Range2}; + {{N,N}, _} -> + {_,FR2} = compare_with_integer(N, Range2), + {Range1, FR2}; + {_, {N,N}} -> + {_,FR1} = compare_with_integer(N, Range1), + {FR1, Range2}; + {_, _} -> + {Range1, Range2} + end, + {TrueRange, TrueRange, FalseRange1, FalseRange2}. -spec range_inequality_propagation(range(), range()) -> {range(), range(), range(), range()}. @@ -778,18 +774,17 @@ analyse_type(Type, Info, Rewrite) -> TypeTest = hipe_icode:type_test(Type), [Arg|_] = hipe_icode:type_args(Type), OldVarRange = get_range_from_arg(Arg), - case TypeTest of - {integer, N} -> - {TrueRange,FalseRange} = compare_with_integer(N,OldVarRange); - integer -> - TrueRange = inf(any_range(), OldVarRange), - FalseRange = inf(none_range(), OldVarRange); - number -> - TrueRange = FalseRange = OldVarRange; - _ -> - TrueRange = inf(none_range(), OldVarRange), - FalseRange = OldVarRange - end, + {TrueRange, FalseRange} = + case TypeTest of + {integer, N} -> + compare_with_integer(N, OldVarRange); + integer -> + {inf(any_range(), OldVarRange), inf(none_range(), OldVarRange)}; + number -> + {OldVarRange, OldVarRange}; + _ -> + {inf(none_range(), OldVarRange), OldVarRange} + end, TrueLabel = hipe_icode:type_true_label(Type), FalseLabel = hipe_icode:type_false_label(Type), TrueInfo = enter_define({Arg, TrueRange}, Info), @@ -1200,14 +1195,12 @@ basic_type(#unsafe_update_element{}) -> not_analysed. analyse_bs_get_integer(Size, Flags, true) -> Signed = Flags band 4, - if Signed =:= 0 -> - Max = 1 bsl Size - 1, - Min = 0; - true -> - Max = 1 bsl (Size-1) - 1, - Min = -(1 bsl (Size-1)) - end, - {Min, Max}; + case Signed =:= 0 of + true -> + {0, inf_add(inf_bsl(1, Size), -1)}; % return {Min, Max} + false -> + {inf_inv(inf_bsl(1, Size-1)), inf_add(inf_bsl(1, Size-1), -1)} + end; analyse_bs_get_integer(Size, Flags, false) when is_integer(Size), is_integer(Flags) -> any_r(). @@ -1652,7 +1645,7 @@ inf_bsl(Number1, Number2) when is_integer(Number1), is_integer(Number2) -> %% State --spec state__init(cfg(), data()) -> #state{}. +-spec state__init(cfg(), data()) -> state(). state__init(Cfg, {MFA, ArgsFun, CallFun, FinalFun}) -> Start = hipe_icode_cfg:start_label(Cfg), @@ -1675,19 +1668,19 @@ state__init(Cfg, {MFA, ArgsFun, CallFun, FinalFun}) -> lookup_fun=CallFun, result_action=FinalFun} end. --spec state__cfg(#state{}) -> cfg(). +-spec state__cfg(state()) -> cfg(). state__cfg(#state{cfg=Cfg}) -> Cfg. --spec state__bb(#state{}, label()) -> bb(). +-spec state__bb(state(), label()) -> bb(). state__bb(#state{cfg=Cfg}, Label) -> BB = hipe_icode_cfg:bb(Cfg, Label), true = hipe_bb:is_bb(BB), % Just an assert BB. --spec state__bb_add(#state{}, label(), bb()) -> #state{}. +-spec state__bb_add(state(), label(), bb()) -> state(). state__bb_add(S=#state{cfg=Cfg}, Label, BB) -> NewCfg = hipe_icode_cfg:bb_add(Cfg, Label, BB), @@ -1773,14 +1766,12 @@ join_info_in([Var|Left], Info1, Info2, Acc, Changed) -> NewTree = gb_trees:insert(Var, Val, Acc), join_info_in(Left, Info1, Info2, NewTree, Changed); {{value, Val1}, {value, Val2}} -> - NewVal = + {NewChanged, NewVal} = case sup(Val1, Val2) of Val1 -> - NewChanged = Changed, - Val1; + {Changed, Val1}; Val -> - NewChanged = true, - Val + {true, Val} end, NewTree = gb_trees:insert(Var, NewVal, Acc), join_info_in(Left, Info1, Info2, NewTree, NewChanged) diff --git a/lib/hipe/icode/hipe_icode_split_arith.erl b/lib/hipe/icode/hipe_icode_split_arith.erl index d59f9247fa..e00a13f82e 100644 --- a/lib/hipe/icode/hipe_icode_split_arith.erl +++ b/lib/hipe/icode/hipe_icode_split_arith.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/icode/hipe_icode_ssa.erl b/lib/hipe/icode/hipe_icode_ssa.erl index 4607a96dda..b222fbc7d2 100644 --- a/lib/hipe/icode/hipe_icode_ssa.erl +++ b/lib/hipe/icode/hipe_icode_ssa.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2011. All Rights Reserved. +%% Copyright Ericsson AB 2002-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -37,7 +38,7 @@ -include("../ssa/hipe_ssa.inc"). %% Declarations for exported functions which are Icode-specific. --spec ssa_liveness__analyze(#cfg{}) -> gb_tree(). +-spec ssa_liveness__analyze(#cfg{}) -> gb_trees:tree(). -spec ssa_liveness__livein(_, icode_lbl()) -> [#icode_variable{}]. %% -spec ssa_liveness__livein(_, icode_lbl(), _) -> [#icode_var{}]. diff --git a/lib/hipe/icode/hipe_icode_ssa_const_prop.erl b/lib/hipe/icode/hipe_icode_ssa_const_prop.erl index f1640b1cee..4ab4d7e95d 100644 --- a/lib/hipe/icode/hipe_icode_ssa_const_prop.erl +++ b/lib/hipe/icode/hipe_icode_ssa_const_prop.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2009. All Rights Reserved. +%% Copyright Ericsson AB 2003-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/icode/hipe_icode_ssa_copy_prop.erl b/lib/hipe/icode/hipe_icode_ssa_copy_prop.erl index 1899c09715..5e5bd2a178 100644 --- a/lib/hipe/icode/hipe_icode_ssa_copy_prop.erl +++ b/lib/hipe/icode/hipe_icode_ssa_copy_prop.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2009. All Rights Reserved. +%% Copyright Ericsson AB 2003-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/icode/hipe_icode_ssa_struct_reuse.erl b/lib/hipe/icode/hipe_icode_ssa_struct_reuse.erl index 2337ef9323..7613024787 100644 --- a/lib/hipe/icode/hipe_icode_ssa_struct_reuse.erl +++ b/lib/hipe/icode/hipe_icode_ssa_struct_reuse.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%% Copyright Ericsson AB 2007-2015. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -70,9 +71,9 @@ %% var - maps variables to expression value numbers. These variables are %% defined or used by the structure expressions. --record(maps, {var = gb_trees:empty() :: gb_tree(), - instr = gb_trees:empty() :: gb_tree(), - expr = gb_trees:empty() :: gb_tree()}). +-record(maps, {var = gb_trees:empty() :: gb_trees:tree(), + instr = gb_trees:empty() :: gb_trees:tree(), + expr = gb_trees:empty() :: gb_trees:tree()}). maps_var(#maps{var = Out}) -> Out. maps_instr(#maps{instr = Out}) -> Out. @@ -211,10 +212,10 @@ varinfo_use_add(#varinfo{use = UseSet} = I, Use) -> pred = none :: 'none' | [icode_lbl()], succ = none :: 'none' | [icode_lbl()], code = [] :: [tuple()], % [illegal_icode_instr()] - phi = gb_trees:empty() :: gb_tree(), + phi = gb_trees:empty() :: gb_trees:tree(), varmap = [] :: [{icode_var(), icode_var()}], pre_loop = false :: boolean(), - non_struct_defs = gb_sets:new() :: gb_set(), + non_struct_defs = gb_sets:new() :: gb_sets:set(), up_expr = none :: 'none' | ?SETS:?SET(_), killed_expr = none :: 'none' | ?SETS:?SET(_), sub_inserts = ?SETS:new() :: ?SETS:?SET(_), @@ -313,13 +314,13 @@ node_create(Label, Pred, Succ) -> %% tree - the tree of nodes, with labels as keys and node records as values -record(nodes, { - domtree :: hipe_dominators:domTree(), + domtree = none :: 'none' | hipe_dominators:domTree(), labels = none :: 'none' | [icode_lbl()], postorder = none :: 'none' | [icode_lbl()], start_label = none :: 'none' | icode_lbl(), rev_postorder = none :: 'none' | [icode_lbl()], all_expr = none :: 'none' | [non_neg_integer()], - tree = gb_trees:empty() :: gb_tree()}). + tree = gb_trees:empty() :: gb_trees:tree()}). nodes_postorder(#nodes{postorder = Out}) -> Out. nodes_rev_postorder(#nodes{rev_postorder = Out}) -> Out. @@ -356,7 +357,7 @@ nodes_create() -> #nodes{}. %% del_red_test - flag that is set to true when the reduction test %% has been inserted is used to move the reduction test. --record(update, {inserted = gb_trees:empty() :: gb_tree(), +-record(update, {inserted = gb_trees:empty() :: gb_trees:tree(), del_red_test = false :: boolean()}). update_inserted_lookup(#update{inserted = Inserted}, ExprId) -> @@ -389,7 +390,7 @@ update_del_red_test_set(Update) -> %%----------------------------------------------------------------------------- %% Main function called from the hipe_main module --spec struct_reuse(#cfg{}) -> #cfg{}. +-spec struct_reuse(cfg()) -> cfg(). struct_reuse(CFG) -> %% debug_init_case_count(?SR_INSTR_TYPE), diff --git a/lib/hipe/icode/hipe_icode_type.erl b/lib/hipe/icode/hipe_icode_type.erl index 046949d2f2..794c27ebcc 100644 --- a/lib/hipe/icode/hipe_icode_type.erl +++ b/lib/hipe/icode/hipe_icode_type.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2012. All Rights Reserved. +%% Copyright Ericsson AB 2003-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -84,26 +85,27 @@ t_fun/0, t_fun/1, t_fun/2, t_fun_args/1, t_fun_arity/1, t_inf/2, t_inf_lists/2, t_integer/0, t_integer/1, t_is_atom/1, t_is_any/1, - t_is_binary/1, t_is_bitstr/1, t_is_bitwidth/1, t_is_boolean/1, - t_is_fixnum/1, t_is_cons/1, + t_is_binary/1, t_is_bitstr/1, t_is_bitwidth/1, + t_is_boolean/1, t_is_fixnum/1, t_is_cons/1, t_is_map/1, t_is_maybe_improper_list/1, t_is_equal/2, t_is_float/1, t_is_fun/1, t_is_integer/1, t_is_non_neg_integer/1, t_is_number/1, t_is_matchstate/1, - t_is_nil/1, t_is_none/1, t_is_port/1, t_is_pid/1, + t_is_none/1, t_is_port/1, t_is_pid/1, t_is_reference/1, t_is_subtype/2, t_is_tuple/1, t_limit/2, t_matchstate_present/1, t_matchstate/0, - t_matchstate_slots/1, t_maybe_improper_list/0, + t_matchstate_slots/1, t_maybe_improper_list/0, t_map/0, t_nil/0, t_none/0, t_number/0, t_number/1, t_number_vals/1, t_pid/0, t_port/0, t_reference/0, t_subtract/2, t_sup/2, t_to_tlist/1, t_tuple/0, t_tuple/1, t_tuple_sizes/1]). --record(state, {info_map = gb_trees:empty() :: gb_tree(), +-record(state, {info_map = gb_trees:empty() :: gb_trees:tree(), cfg :: cfg(), - liveness = gb_trees:empty() :: gb_tree(), + liveness = gb_trees:empty() :: gb_trees:tree(), arg_types :: [erl_types:erl_type()], ret_type = [t_none()] :: [erl_types:erl_type()], lookupfun :: call_fun(), resultaction :: final_fun()}). +-type state() :: #state{}. %%----------------------------------------------------------------------- %% The main exported function @@ -192,7 +194,7 @@ analyse(Cfg, Data) -> catch throw:no_input -> ok % No need to do anything since we have no input end. --spec safe_analyse(cfg(), data()) -> #state{}. +-spec safe_analyse(cfg(), data()) -> state(). safe_analyse(Cfg, {MFA,_,_,_}=Data) -> State = new_state(Cfg, Data), @@ -213,7 +215,7 @@ analyse_blocks(Work, State, MFA) -> {NewState, NewLabels} = try analyse_block(Label, Info, State) catch throw:none_type -> - %% io:format("received none type at label: ~p~n",[Label]), + %% io:format("received none type at label: ~p~n", [Label]), {State,[]} end, NewWork2 = add_work(NewWork, NewLabels), @@ -265,7 +267,7 @@ analyse_insn(I, Info, LookupFun) -> do_move(I, Info); #icode_call{} -> NewInfo = do_call(I, Info, LookupFun), - %%io:format("Analysing Call: ~w~n~w~n", [I,NewInfo]), + %% io:format("Analysing Call: ~w~n~w~n", [I, NewInfo]), update_call_arguments(I, NewInfo); #icode_phi{} -> Type = t_limit(join_list(hipe_icode:args(I), Info), ?TYPE_DEPTH), @@ -362,6 +364,7 @@ call_always_fails(#icode_call{} = I, Info) -> %% These can actually be calls too. {erlang, halt, 0} -> false; {erlang, halt, 1} -> false; + {erlang, halt, 2} -> false; {erlang, exit, 1} -> false; {erlang, error, 1} -> false; {erlang, error, 2} -> false; @@ -459,24 +462,24 @@ integer_range_inequality_propagation(Op, A1, A2, TrueLab, FalseLab, Info) -> NonIntArg1 = t_subtract(Arg1, t_integer()), NonIntArg2 = t_subtract(Arg2, t_integer()), ?ineq_debug("nonintargs", [NonIntArg1,NonIntArg2]), - case t_is_none(IntArg1) or t_is_none(IntArg2) of + case t_is_none(IntArg1) orelse t_is_none(IntArg2) of true -> ?ineq_debug("one is none", [IntArg1,IntArg2]), [{TrueLab, Info}, {FalseLab, Info}]; false -> - case Op of - '>=' -> - {FalseArg1, FalseArg2, TrueArg1, TrueArg2} = - integer_range_less_then_propagator(IntArg1, IntArg2); - '>' -> - {TrueArg2, TrueArg1, FalseArg2, FalseArg1} = - integer_range_less_then_propagator(IntArg2, IntArg1); - '<' -> - {TrueArg1, TrueArg2, FalseArg1, FalseArg2} = - integer_range_less_then_propagator(IntArg1, IntArg2); - '=<' -> - {FalseArg2, FalseArg1, TrueArg2, TrueArg1} = - integer_range_less_then_propagator(IntArg2, IntArg1) + {TrueArg1, TrueArg2, FalseArg1, FalseArg2} = + case Op of + '>=' -> + {FA1, FA2, TA1, TA2} = int_range_lt_propagator(IntArg1, IntArg2), + {TA1, TA2, FA1, FA2}; + '>' -> + {TA2, TA1, FA2, FA1} = int_range_lt_propagator(IntArg2, IntArg1), + {TA1, TA2, FA1, FA2}; + '<' -> + int_range_lt_propagator(IntArg1, IntArg2); + '=<' -> + {FA2, FA1, TA2, TA1} = int_range_lt_propagator(IntArg2, IntArg1), + {TA1, TA2, FA1, FA2} end, ?ineq_debug("int res", [TrueArg1, TrueArg2, FalseArg1, FalseArg2]), False = {FalseLab, enter(A1, t_sup(FalseArg1, NonIntArg1), @@ -486,7 +489,7 @@ integer_range_inequality_propagation(Op, A1, A2, TrueLab, FalseLab, Info) -> [True, False] end. -integer_range_less_then_propagator(IntArg1, IntArg2) -> +int_range_lt_propagator(IntArg1, IntArg2) -> Min1 = number_min(IntArg1), Max1 = number_max(IntArg1), Min2 = number_min(IntArg2), @@ -788,16 +791,16 @@ test_record(Atom, Size, Var, VarInfo, TrueLab, FalseLab, Info) -> end. test_type(Test, Type) -> - %%io:format("Test is: ~w\n", [Test]), - %%io:format("Type is: ~s\n", [format_type(Type)]), + %% io:format("Test is: ~w\n", [Test]), + %% io:format("Type is: ~s\n", [format_type(Type)]), Ans = case t_is_any(Type) of true -> maybe; false -> TrueTest = true_branch_info(Test), Inf = t_inf(TrueTest, Type), - %%io:format("TrueTest is: ~s\n", [format_type(TrueTest)]), - %%io:format("Inf is: ~s\n", [format_type(Inf)]), + %% io:format("TrueTest is: ~s\n", [format_type(TrueTest)]), + %% io:format("Inf is: ~s\n", [format_type(Inf)]), case t_is_equal(Type, Inf) of true -> not t_is_none(Type); @@ -895,11 +898,12 @@ test_type0(boolean, T) -> t_is_boolean(T); test_type0(list, T) -> t_is_maybe_improper_list(T); -test_type0(cons, T) -> - t_is_cons(T); -test_type0(nil, T) -> - t_is_nil(T). - +%% test_type0(cons, T) -> +%% t_is_cons(T); +%% test_type0(nil, T) -> +%% t_is_nil(T). +test_type0(map, T) -> + t_is_map(T). true_branch_info(integer) -> t_integer(); @@ -931,22 +935,24 @@ true_branch_info(reference) -> t_reference(); true_branch_info(function) -> t_fun(); -true_branch_info(cons) -> - t_cons(); -true_branch_info(nil) -> - t_nil(); +%% true_branch_info(cons) -> +%% t_cons(); +%% true_branch_info(nil) -> +%% t_nil(); true_branch_info(boolean) -> t_boolean(); +true_branch_info(map) -> + t_map(); true_branch_info(T) -> - exit({?MODULE,unknown_typetest,T}). + exit({?MODULE, unknown_typetest, T}). %% _________________________________________________________________ %% %% Remove the redundant type tests. If a test is removed, the trace -%% that isn't taken is explicitly removed from the CFG to simpilify +%% that isn't taken is explicitly removed from the CFG to simplify %% the handling of Phi nodes. If a Phi node is left and at least one -%% branch into it has disappeared, the SSA propagation pass can't +%% branch into it has disappeared, the SSA propagation pass cannot %% handle it. %% %% If the CFG has changed at the end of this pass, the analysis is diff --git a/lib/hipe/icode/hipe_icode_type.hrl b/lib/hipe/icode/hipe_icode_type.hrl index dd69c1e8b2..466e157646 100644 --- a/lib/hipe/icode/hipe_icode_type.hrl +++ b/lib/hipe/icode/hipe_icode_type.hrl @@ -1,18 +1,19 @@ %%% %%% %CopyrightBegin% %%% -%%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %%% -%%% The contents of this file are subject to the Erlang Public License, -%%% Version 1.1, (the "License"); you may not use this file except in -%%% compliance with the License. You should have received a copy of the -%%% Erlang Public License along with this software. If not, it can be -%%% retrieved online at http://www.erlang.org/. -%%% -%%% Software distributed under the License is distributed on an "AS IS" -%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%%% the License for the specific language governing rights and limitations -%%% under the License. +%%% Licensed under the Apache License, Version 2.0 (the "License"); +%%% you may not use this file except in compliance with the License. +%%% You may obtain a copy of the License at +%%% +%%% http://www.apache.org/licenses/LICENSE-2.0 +%%% +%%% Unless required by applicable law or agreed to in writing, software +%%% distributed under the License is distributed on an "AS IS" BASIS, +%%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%%% See the License for the specific language governing permissions and +%%% limitations under the License. %%% %%% %CopyrightEnd% %%% diff --git a/lib/hipe/llvm/Makefile b/lib/hipe/llvm/Makefile new file mode 100644 index 0000000000..88016a7d8b --- /dev/null +++ b/lib/hipe/llvm/Makefile @@ -0,0 +1,117 @@ +# +# %CopyrightBegin% +# +# Copyright Ericsson AB 2001-2016. All Rights Reserved. +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. +# +# %CopyrightEnd% +# + +ifndef EBIN +EBIN = ../ebin +endif + +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# ---------------------------------------------------- +# Application version +# ---------------------------------------------------- +include ../vsn.mk +VSN=$(HIPE_VSN) + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELSYSDIR = $(RELEASE_PATH)/lib/hipe-$(VSN) + +# ---------------------------------------------------- +# Target Specs +# ---------------------------------------------------- +ifdef HIPE_ENABLED +HIPE_MODULES = elf_format \ + hipe_llvm \ + hipe_llvm_liveness \ + hipe_llvm_main \ + hipe_llvm_merge \ + hipe_rtl_to_llvm +else +HIPE_MODULES = +endif + +MODULES = $(HIPE_MODULES) + +HRL_FILES= elf_format.hrl elf32_format.hrl elf64_format.hrl hipe_llvm_arch.hrl +ERL_FILES= $(MODULES:%=%.erl) +TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) + +# APP_FILE= +# App_SRC= $(APP_FILE).src +# APP_TARGET= $(EBIN)/$(APP_FILE) +# +# APPUP_FILE= +# APPUP_SRC= $(APPUP_FILE).src +# APPUP_TARGET= $(EBIN)/$(APPUP_FILE) + +# ---------------------------------------------------- +# FLAGS: Please keep +inline below +# ---------------------------------------------------- + +include ../native.mk + +ERL_COMPILE_FLAGS += -Werror +inline +warn_export_vars #+warn_missing_spec + +# if in 32 bit backend define BIT32 symbol +ARCH = $(shell echo $(TARGET) | sed 's/^\(x86_64\)-.*/64bit/') +ifneq ($(ARCH), 64bit) +ERL_COMPILE_FLAGS += -DBIT32 +endif + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- + +debug opt: $(TARGET_FILES) + +docs: + +clean: + rm -f $(TARGET_FILES) + rm -f core erl_crash.dump + +# ---------------------------------------------------- +# Special Build Targets +# ---------------------------------------------------- + + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +release_spec: opt + $(INSTALL_DIR) $(RELSYSDIR)/llvm + $(INSTALL_DATA) $(ERL_FILES) $(HRL_FILES) $(RELSYSDIR)/llvm + $(INSTALL_DIR) $(RELSYSDIR)/ebin + $(INSTALL_DATA) $(TARGET_FILES) $(RELSYSDIR)/ebin + +release_docs_spec: + +$(EBIN)/elf_format.beam: elf_format.hrl elf32_format.hrl elf64_format.hrl +$(EBIN)/hipe_llvm_main.beam: ../../kernel/src/hipe_ext_format.hrl \ + hipe_llvm_arch.hrl elf_format.hrl elf32_format.hrl elf64_format.hrl +$(EBIN)/hipe_llvm_merge.beam: ../../kernel/src/hipe_ext_format.hrl \ + hipe_llvm_arch.hrl ../rtl/hipe_literals.hrl ../main/hipe.hrl +$(EBIN)/hipe_rtl_to_llvm.beam: ../rtl/hipe_rtl.hrl ../rtl/hipe_literals.hrl \ + hipe_llvm_arch.hrl diff --git a/lib/hipe/llvm/elf32_format.hrl b/lib/hipe/llvm/elf32_format.hrl new file mode 100644 index 0000000000..af1d95bf5b --- /dev/null +++ b/lib/hipe/llvm/elf32_format.hrl @@ -0,0 +1,59 @@ +%% -*- erlang-indent-level: 2 -*- + +%%% @copyright 2011-2014 Yiannis Tsiouris <[email protected]>, +%%% Chris Stavrakakis <[email protected]> +%%% @author Yiannis Tsiouris <[email protected]> +%%% [http://www.softlab.ntua.gr/~gtsiour/] + +%%% @doc This header file contains very very useful macros for handling +%%% various segments of an ELF-32 formated object file, such as sizes, +%%% offsets and predefined constants. For further information about +%%% each field take a quick look at +%%% "[http://www.sco.com/developers/gabi/latest/contents.html]" +%%% that contain the current HP/Intel definition of the ELF object +%%% file format. + +%%------------------------------------------------------------------------------ +%% ELF-32 Data Types (in bytes) +%%------------------------------------------------------------------------------ +-define(ELF_ADDR_SIZE, 4). +-define(ELF_OFF_SIZE, 4). +-define(ELF_HALF_SIZE, 2). +-define(ELF_WORD_SIZE, 4). +-define(ELF_SWORD_SIZE, 4). +-define(ELF_XWORD_SIZE, ?ELF_WORD_SIZE). % for compatibility +-define(ELF_SXWORD_SIZE, ?ELF_WORD_SIZE). +-define(ELF_UNSIGNED_CHAR_SIZE, 1). + +%%------------------------------------------------------------------------------ +%% ELF-32 Symbol Table Entries +%%------------------------------------------------------------------------------ +%% Precomputed offset for Symbol Table entries in SymTab binary (needed because +%% of the different offsets in 32 and 64 bit formats). +-define(ST_NAME_OFFSET, 0). +-define(ST_VALUE_OFFSET, (?ST_NAME_OFFSET + ?ST_NAME_SIZE) ). +-define(ST_SIZE_OFFSET, (?ST_VALUE_OFFSET + ?ST_VALUE_SIZE) ). +-define(ST_INFO_OFFSET, (?ST_SIZE_OFFSET + ?ST_SIZE_SIZE) ). +-define(ST_OTHER_OFFSET, (?ST_INFO_OFFSET + ?ST_INFO_SIZE) ). +-define(ST_SHNDX_OFFSET, (?ST_OTHER_OFFSET + ?ST_OTHER_SIZE) ). + +%%------------------------------------------------------------------------------ +%% ELF-64 Relocation Entries +%%------------------------------------------------------------------------------ +%% Useful macros to extract information from r_info field +-define(ELF_R_SYM(I), (I bsr 8) ). +-define(ELF_R_TYPE(I), (I band 16#ff) ). +-define(ELF_R_INFO(S, T), ((S bsl 8) + (T band 16#ff)) ). + +%%------------------------------------------------------------------------------ +%% ELF-64 Program Header Table +%%------------------------------------------------------------------------------ +%% Offsets of various fields in a Program Header Table entry binary. +-define(P_TYPE_OFFSET, 0). +-define(P_OFFSET_OFFSET, (?P_FLAGS_OFFSET + ?P_FLAGS_SIZE) ). +-define(P_VADDR_OFFSET, (?P_OFFSET_OFFSET + ?P_OFFSET_SIZE) ). +-define(P_PADDR_OFFSET, (?P_VADDR_OFFSET + ?P_VADDR_SIZE) ). +-define(P_FILESZ_OFFSET, (?P_PVADDR_OFFSET + ?P_PVADDR_SIZE) ). +-define(P_MEMSZ_OFFSET, (?P_FILESZ_OFFSET + ?P_FILESZ_SIZE) ). +-define(P_FLAGS_OFFSET, (?P_TYPE_OFFSET + ?P_TYPE_SIZE) ). +-define(P_ALIGN_OFFSET, (?P_MEMSZ_OFFSET + ?P_MEMSZ_SIZE) ). diff --git a/lib/hipe/llvm/elf64_format.hrl b/lib/hipe/llvm/elf64_format.hrl new file mode 100644 index 0000000000..794746ffdc --- /dev/null +++ b/lib/hipe/llvm/elf64_format.hrl @@ -0,0 +1,58 @@ +%% -*- erlang-indent-level: 2 -*- + +%%% @copyright 2011-2014 Yiannis Tsiouris <[email protected]>, +%%% Chris Stavrakakis <[email protected]> +%%% @author Yiannis Tsiouris <[email protected]> +%%% [http://www.softlab.ntua.gr/~gtsiour/] + +%%% @doc This header file contains very very useful macros for handling +%%% various segments of an ELF-64 formated object file, such as sizes, +%%% offsets and predefined constants. For further information about +%%% each field take a quick look at +%%% "[http://downloads.openwatcom.org/ftp/devel/docs/elf-64-gen.pdf]" +%%% that contain the current HP/Intel definition of the ELF object +%%% file format. + +%%------------------------------------------------------------------------------ +%% ELF-64 Data Types (in bytes) +%%------------------------------------------------------------------------------ +-define(ELF_ADDR_SIZE, 8). +-define(ELF_OFF_SIZE, 8). +-define(ELF_HALF_SIZE, 2). +-define(ELF_WORD_SIZE, 4). +-define(ELF_SWORD_SIZE, 4). +-define(ELF_XWORD_SIZE, 8). +-define(ELF_SXWORD_SIZE, 8). +-define(ELF_UNSIGNED_CHAR_SIZE, 1). + +%%------------------------------------------------------------------------------ +%% ELF-64 Symbol Table Entries +%%------------------------------------------------------------------------------ +%% Precomputed offset for Symbol Table entries in SymTab binary +-define(ST_NAME_OFFSET, 0). +-define(ST_INFO_OFFSET, (?ST_NAME_OFFSET + ?ST_NAME_SIZE) ). +-define(ST_OTHER_OFFSET, (?ST_INFO_OFFSET + ?ST_INFO_SIZE) ). +-define(ST_SHNDX_OFFSET, (?ST_OTHER_OFFSET + ?ST_OTHER_SIZE) ). +-define(ST_VALUE_OFFSET, (?ST_SHNDX_OFFSET + ?ST_SHNDX_SIZE) ). +-define(ST_SIZE_OFFSET, (?ST_VALUE_OFFSET + ?ST_VALUE_SIZE) ). + +%%------------------------------------------------------------------------------ +%% ELF-64 Relocation Entries +%%------------------------------------------------------------------------------ +%% Useful macros to extract information from r_info field +-define(ELF_R_SYM(I), (I bsr 32) ). +-define(ELF_R_TYPE(I), (I band 16#ffffffff) ). +-define(ELF_R_INFO(S, T), ((S bsl 32) + (T band 16#ffffffff)) ). + +%%------------------------------------------------------------------------------ +%% ELF-64 Program Header Table +%%------------------------------------------------------------------------------ +%% Offsets of various fields in a Program Header Table entry binary. +-define(P_TYPE_OFFSET, 0). +-define(P_FLAGS_OFFSET, (?P_TYPE_OFFSET + ?P_TYPE_SIZE) ). +-define(P_OFFSET_OFFSET, (?P_FLAGS_OFFSET + ?P_FLAGS_SIZE) ). +-define(P_VADDR_OFFSET, (?P_OFFSET_OFFSET + ?P_OFFSET_SIZE) ). +-define(P_PADDR_OFFSET, (?P_VADDR_OFFSET + ?P_VADDR_SIZE) ). +-define(P_FILESZ_OFFSET, (?P_PVADDR_OFFSET + ?P_PVADDR_SIZE) ). +-define(P_MEMSZ_OFFSET, (?P_FILESZ_OFFSET + ?P_FILESZ_SIZE) ). +-define(P_ALIGN_OFFSET, (?P_MEMSZ_OFFSET + ?P_MEMSZ_SIZE) ). diff --git a/lib/hipe/llvm/elf_format.erl b/lib/hipe/llvm/elf_format.erl new file mode 100644 index 0000000000..8cf6ea6250 --- /dev/null +++ b/lib/hipe/llvm/elf_format.erl @@ -0,0 +1,620 @@ +%% -*- erlang-indent-level: 2 -*- + +%%% @copyright 2011-2014 Yiannis Tsiouris <[email protected]>, +%%% Chris Stavrakakis <[email protected]>, +%%% Kostis Sagonas <[email protected]> +%%% @author Yiannis Tsiouris <[email protected]> +%%% [http://www.softlab.ntua.gr/~gtsiour/] + +%%% @doc This module contains functions for extracting various pieces of +%%% information from an ELF formated Object file. To fully understand +%%% the ELF format and the use of these functions please read +%%% "[http://www.linuxjournal.com/article/1060?page=0,0]" carefully. + +-module(elf_format). + +-export([%% Relocations + extract_rela/2, + %% Note + extract_note/2, + %% Executable code + extract_text/1, + %% GCC Exception Table + get_exn_handlers/1, + %% Symbols + elf_symbols/1, + %% Sections + section_contents/2, + %% Main interface + read/1 + ]). + +-include("elf_format.hrl"). + +%%------------------------------------------------------------------------------ +%% Types +%%------------------------------------------------------------------------------ + +-export_type([elf/0 + ,addend/0 + ,bitflags/0 + ,name/0 + ,offset/0 + ,reloc_type/0 + ,shdr_type/0 + ,size/0 + ,sym_bind/0 + ,sym_type/0 + ,valueoff/0 + ]). + +-type bitflags() :: non_neg_integer(). +-type index() :: non_neg_integer(). +-type lp() :: non_neg_integer(). % landing pad +-type num() :: non_neg_integer(). +-type offset() :: non_neg_integer(). +-type size() :: non_neg_integer(). +-type start() :: non_neg_integer(). + +-type addend() :: integer() | undefined. +-type name() :: string(). +-type shdr_type() :: 'null' | 'progbits' | 'symtab' | 'strtab' | 'rela' + | 'hash' | 'dynamic' | 'note' | 'nobits' | 'rel' | 'shlib' + | 'dynsym' | {os, ?SHT_LOOS..?SHT_HIOS} + | {proc, ?SHT_LOPROC..?SHT_HIPROC}. +-type sym_bind() :: 'local' | 'global' | 'weak' | {os, ?STB_LOOS..?STB_HIOS} + | {proc, ?STB_LOPROC..?STB_HIPROC}. +-type sym_type() :: 'notype' | 'object' | 'func' | 'section' | 'file' + | {os, ?STT_LOOS..?STT_HIOS} + | {proc, ?STT_LOPROC..?STT_HIPROC}. +-type valueoff() :: offset(). + +-ifdef(BIT32). % 386 +-type reloc_type() :: '32' | 'pc32'. +-else. % X86_64 +-type reloc_type() :: '64' | 'pc32' | '32'. +-endif. + +%%------------------------------------------------------------------------------ +%% Abstract Data Types and Accessors for ELF Structures. +%%------------------------------------------------------------------------------ + +-record(elf, {file :: binary() + ,sections :: [elf_shdr()] + ,sec_nam :: #{string() => elf_shdr()} + ,symbols :: undefined | [elf_sym()] + }). +-opaque elf() :: #elf{}. + +%% File header +-record(elf_ehdr, {ident, % ELF identification + type, % Object file type + machine, % Machine Type + version, % Object file version + entry, % Entry point address + phoff, % Program header offset + shoff :: offset(), % Section header offset + flags, % Processor-specific flags + ehsize :: size(), % ELF header size + phentsize :: size(), % Size of program header entry + phnum :: num(), % Number of program header entries + shentsize :: size(), % Size of section header entry + shnum :: num(), % Number of section header entries + shstrndx :: index() % Section name string table index + }). +-type elf_ehdr() :: #elf_ehdr{}. + +-record(elf_ehdr_ident, {class, % File class + data, % Data encoding + version, % File version + osabi, % OS/ABI identification + abiversion, % ABI version + pad, % Start of padding bytes + nident % Size of e_ident[] + }). +%% -type elf_ehdr_ident() :: #elf_ehdr_ident{}. + +%% %% Program header table +%% -record(elf_phdr, {type, % Type of segment +%% flags, % Segment attributes +%% offset, % Offset in file +%% vaddr, % Virtual address in memory +%% paddr, % Reserved +%% filesz, % Size of segment in file +%% memsz, % Size of segment in memory +%% align % Alignment of segment +%% }). + +%% %% GCC exception table +%% -record(elf_gccexntab, {lpbenc, % Landing pad base encoding +%% lpbase, % Landing pad base +%% ttenc, % Type table encoding +%% ttoff, % Type table offset +%% csenc, % Call-site table encoding +%% cstabsize, % Call-site table size +%% cstab :: cstab() % Call-site table +%% }). +%% -type elf_gccexntab() :: #elf_gccexntab{}. + +-record(elf_gccexntab_callsite, {start :: start(), % Call-site start + size :: size(), % Call-site size + lp :: lp(), % Call-site landing pad + % (exception handler) + onaction % On action (e.g. cleanup) + }). +%% -type elf_gccexntab_callsite() :: #elf_gccexntab_callsite{}. + +%%------------------------------------------------------------------------------ +%% Accessor Functions +%%------------------------------------------------------------------------------ + +%% File header +%% -spec mk_ehdr(...) -> elf_ehrd(). +mk_ehdr(Ident, Type, Machine, Version, Entry, Phoff, Shoff, Flags, Ehsize, + Phentsize, Phnum, Shentsize, Shnum, Shstrndx) -> + #elf_ehdr{ident = Ident, type = Type, machine = Machine, version = Version, + entry = Entry, phoff = Phoff, shoff = Shoff, flags = Flags, + ehsize = Ehsize, phentsize = Phentsize, phnum = Phnum, + shentsize = Shentsize, shnum = Shnum, shstrndx = Shstrndx}. + +%% -spec ehdr_shoff(elf_ehdr()) -> offset(). +%% ehdr_shoff(#elf_ehdr{shoff = Offset}) -> Offset. +%% +%% -spec ehdr_shentsize(elf_ehdr()) -> size(). +%% ehdr_shentsize(#elf_ehdr{shentsize = Size}) -> Size. +%% +%% -spec ehdr_shnum(elf_ehdr()) -> num(). +%% ehdr_shnum(#elf_ehdr{shnum = Num}) -> Num. +%% +%% -spec ehdr_shstrndx(elf_ehdr()) -> index(). +%% ehdr_shstrndx(#elf_ehdr{shstrndx = Index}) -> Index. + + +%%-spec mk_ehdr_ident(...) -> elf_ehdr_ident(). +mk_ehdr_ident(Class, Data, Version, OsABI, AbiVersion, Pad, Nident) -> + #elf_ehdr_ident{class = Class, data = Data, version = Version, osabi = OsABI, + abiversion = AbiVersion, pad = Pad, nident = Nident}. + +%%%------------------------- +%%% Section header entries +%%%------------------------- +mk_shdr(Name, Type, Flags, Addr, Offset, Size, Link, Info, AddrAlign, EntSize) -> + #elf_shdr{name = Name, type = Type, flags = Flags, addr = Addr, + offset = Offset, size = Size, link = Link, info = Info, + addralign = AddrAlign, entsize = EntSize}. + +%% -spec shdr_offset(elf_shdr()) -> offset(). +%% shdr_offset(#elf_shdr{offset = Offset}) -> Offset. +%% +%% -spec shdr_size(elf_shdr()) -> size(). +%% shdr_size(#elf_shdr{size = Size}) -> Size. + +%%%------------------------- +%%% Symbol Table Entries +%%%------------------------- +mk_sym(Name, Bind, Type, Section, Value, Size) -> + #elf_sym{name = Name, bind = Bind, type = Type, + section = Section, value = Value, size = Size}. + +%% -spec sym_name(elf_sym()) -> string(). +%% sym_name(#elf_sym{name = Name}) -> Name. +%% +%% -spec sym_value(elf_sym()) -> valueoff(). +%% sym_value(#elf_sym{value = Value}) -> Value. +%% +%% -spec sym_size(elf_sym()) -> size(). +%% sym_size(#elf_sym{size = Size}) -> Size. + +%% %%%------------------------- +%% %%% GCC exception table +%% %%%------------------------- +%% -type cstab() :: [elf_gccexntab_callsite()]. +%% +%% mk_gccexntab(LPbenc, LPbase, TTenc, TToff, CSenc, CStabsize, CStab) -> +%% #elf_gccexntab{lpbenc = LPbenc, lpbase = LPbase, ttenc = TTenc, +%% ttoff = TToff, csenc = CSenc, cstabsize = CStabsize, +%% cstab = CStab}. +%% +%% -spec gccexntab_cstab(elf_gccexntab()) -> cstab(). +%% gccexntab_cstab(#elf_gccexntab{cstab = CSTab}) -> CSTab. + +mk_gccexntab_callsite(Start, Size, LP, Action) -> + #elf_gccexntab_callsite{start = Start, size=Size, lp=LP, onaction=Action}. + +%% -spec gccexntab_callsite_start(elf_gccexntab_callsite()) -> start(). +%% gccexntab_callsite_start(#elf_gccexntab_callsite{start = Start}) -> Start. +%% +%% -spec gccexntab_callsite_size(elf_gccexntab_callsite()) -> size(). +%% gccexntab_callsite_size(#elf_gccexntab_callsite{size = Size}) -> Size. +%% +%% -spec gccexntab_callsite_lp(elf_gccexntab_callsite()) -> lp(). +%% gccexntab_callsite_lp(#elf_gccexntab_callsite{lp = LP}) -> LP. + +%%------------------------------------------------------------------------------ +%% Main interface function +%%------------------------------------------------------------------------------ + +%% @doc Parses an ELF file. +-spec read(binary()) -> elf(). +read(ElfBin) -> + Header = extract_header(ElfBin), + [_UndefinedSec|Sections] = extract_shdrtab(ElfBin, Header), + SecNam = maps:from_list( + [{Name, Sec} || Sec = #elf_shdr{name=Name} <- Sections]), + Elf0 = #elf{file=ElfBin, sections=Sections, sec_nam=SecNam}, + [_UndefinedSym|Symbols] = extract_symtab(Elf0, extract_strtab(Elf0)), + Elf0#elf{symbols=Symbols}. + +%%------------------------------------------------------------------------------ +%% Functions to manipulate the ELF File Header +%%------------------------------------------------------------------------------ + +%% @doc Extracts the File Header from an ELF formatted object file. Also sets +%% the ELF class variable in the process dictionary (used by many functions +%% in this and hipe_llvm_main modules). +-spec extract_header(binary()) -> elf_ehdr(). +extract_header(ElfBin) -> + Ehdr_bin = get_binary_segment(ElfBin, 0, ?ELF_EHDR_SIZE), + << %% Structural pattern matching on fields. + Ident_bin:?E_IDENT_SIZE/binary, + Type:?bits(?E_TYPE_SIZE)/integer-little, + Machine:?bits(?E_MACHINE_SIZE)/integer-little, + Version:?bits(?E_VERSION_SIZE)/integer-little, + Entry:?bits(?E_ENTRY_SIZE)/integer-little, + Phoff:?bits(?E_PHOFF_SIZE)/integer-little, + Shoff:?bits(?E_SHOFF_SIZE)/integer-little, + Flags:?bits(?E_FLAGS_SIZE)/integer-little, + Ehsize:?bits(?E_EHSIZE_SIZE)/integer-little, + Phentsize:?bits(?E_PHENTSIZE_SIZE)/integer-little, + Phnum:?bits(?E_PHNUM_SIZE)/integer-little, + Shentsize:?bits(?E_SHENTSIZE_SIZE)/integer-little, + Shnum:?bits(?E_SHENTSIZE_SIZE)/integer-little, + Shstrndx:?bits(?E_SHSTRNDX_SIZE)/integer-little + >> = Ehdr_bin, + <<16#7f, $E, $L, $F, Class, Data, Version, Osabi, Abiversion, + Pad:6/binary, Nident + >> = Ident_bin, + Ident = mk_ehdr_ident(Class, Data, Version, Osabi, + Abiversion, Pad, Nident), + mk_ehdr(Ident, Type, Machine, Version, Entry, Phoff, Shoff, Flags, + Ehsize, Phentsize, Phnum, Shentsize, Shnum, Shstrndx). + +%%------------------------------------------------------------------------------ +%% Functions to manipulate Section Header Entries +%%------------------------------------------------------------------------------ + +-type shdrtab() :: [elf_shdr()]. + +%% @doc Extracts the Section Header Table from an ELF formated Object File. +-spec extract_shdrtab(binary(), elf_ehdr()) -> shdrtab(). +extract_shdrtab(ElfBin, #elf_ehdr{shoff=ShOff, shentsize=?ELF_SHDRENTRY_SIZE, + shnum=ShNum, shstrndx=ShStrNdx}) -> + %% Get actual Section header table (binary) + ShdrBin = get_binary_segment(ElfBin, ShOff, ShNum * ?ELF_SHDRENTRY_SIZE), + %% We need to lookup the offset and size of the section header string table + %% before we can fully parse the section table. We compute its offset and + %% extract the fields we need here. + ShStrEntryOffset = ShStrNdx * ?ELF_SHDRENTRY_SIZE, + <<_:ShStrEntryOffset/binary, _:?SH_NAME_SIZE/binary, + _:?SH_TYPE_SIZE/binary, _:?SH_FLAGS_SIZE/binary, _:?SH_ADDR_SIZE/binary, + ShStrOffset:?bits(?SH_OFFSET_SIZE)/little, + ShStrSize:?bits(?SH_SIZE_SIZE)/little, + _/binary>> = ShdrBin, + ShStrTab = parse_strtab(get_binary_segment(ElfBin, ShStrOffset, ShStrSize)), + get_shdrtab_entries(ShdrBin, ShStrTab). + +get_shdrtab_entries(<<>>, _ShStrTab) -> []; +get_shdrtab_entries(ShdrTab, ShStrTab) -> + <<%% Structural pattern matching on fields. + Name:?bits(?SH_NAME_SIZE)/integer-little, + Type:?bits(?SH_TYPE_SIZE)/integer-little, + Flags:?bits(?SH_FLAGS_SIZE)/integer-little, + Addr:?bits(?SH_ADDR_SIZE)/integer-little, + Offset:?bits(?SH_OFFSET_SIZE)/integer-little, + Size:?bits(?SH_SIZE_SIZE)/integer-little, + Link:?bits(?SH_LINK_SIZE)/integer-little, + Info:?bits(?SH_INFO_SIZE)/integer-little, + Addralign:?bits(?SH_ADDRALIGN_SIZE)/integer-little, + Entsize:?bits(?SH_ENTSIZE_SIZE)/integer-little, + Rest/binary + >> = ShdrTab, + Entry = mk_shdr(get_strtab_entry(Name, ShStrTab), decode_shdr_type(Type), + Flags, Addr, Offset, Size, Link, Info, Addralign, Entsize), + [Entry | get_shdrtab_entries(Rest, ShStrTab)]. + +decode_shdr_type(?SHT_NULL) -> 'null'; +decode_shdr_type(?SHT_PROGBITS) -> 'progbits'; +decode_shdr_type(?SHT_SYMTAB) -> 'symtab'; +decode_shdr_type(?SHT_STRTAB) -> 'strtab'; +decode_shdr_type(?SHT_RELA) -> 'rela'; +decode_shdr_type(?SHT_HASH) -> 'hash'; %unused +decode_shdr_type(?SHT_DYNAMIC) -> 'dynamic'; %unused +decode_shdr_type(?SHT_NOTE) -> 'note'; %unused +decode_shdr_type(?SHT_NOBITS) -> 'nobits'; +decode_shdr_type(?SHT_REL) -> 'rel'; +decode_shdr_type(?SHT_SHLIB) -> 'shlib'; %unused +decode_shdr_type(?SHT_DYNSYM) -> 'dynsym'; %unused +decode_shdr_type(OS) when ?SHT_LOOS =< OS, OS =< ?SHT_HIOS -> {os, OS}; +decode_shdr_type(Proc) when ?SHT_LOPROC =< Proc, Proc =< ?SHT_HIPROC -> + {proc, Proc}. + +-spec elf_section(non_neg_integer(), elf()) -> undefined | abs | elf_shdr(). +elf_section(0, #elf{}) -> undefined; +elf_section(?SHN_ABS, #elf{}) -> abs; +elf_section(Index, #elf{sections=SecIdx}) -> + lists:nth(Index, SecIdx). + +%% Reads the contents of a section from an object +-spec section_contents(elf_shdr(), elf()) -> binary(). +section_contents(#elf_shdr{offset=Offset, size=Size}, #elf{file=ElfBin}) -> + get_binary_segment(ElfBin, Offset, Size). + +%%------------------------------------------------------------------------------ +%% Functions to manipulate Symbol Table +%%------------------------------------------------------------------------------ + +%% @doc Function that extracts Symbol Table from an ELF Object file. +extract_symtab(Elf, StrTab) -> + Symtab = extract_segment_by_name(Elf, ?SYMTAB), + [parse_sym(Sym, Elf, StrTab) || <<Sym:?ELF_SYM_SIZE/binary>> <= Symtab]. + +-ifdef(BIT32). +parse_sym(<<%% Structural pattern matching on fields. + Name:?bits(?ST_NAME_SIZE)/integer-little, + Value:?bits(?ST_VALUE_SIZE)/integer-little, + Size:?bits(?ST_SIZE_SIZE)/integer-little, + Info:?bits(?ST_INFO_SIZE)/integer-little, + _Other:?bits(?ST_OTHER_SIZE)/integer-little, + Shndx:?bits(?ST_SHNDX_SIZE)/integer-little>>, + Elf, StrTab) -> + mk_sym(get_strtab_entry(Name, StrTab), decode_symbol_bind(?ELF_ST_BIND(Info)), + decode_symbol_type(?ELF_ST_TYPE(Info)), elf_section(Shndx, Elf), Value, + Size). +-else. +parse_sym(<<%% Same fields in different order: + Name:?bits(?ST_NAME_SIZE)/integer-little, + Info:?bits(?ST_INFO_SIZE)/integer-little, + _Other:?bits(?ST_OTHER_SIZE)/integer-little, + Shndx:?bits(?ST_SHNDX_SIZE)/integer-little, + Value:?bits(?ST_VALUE_SIZE)/integer-little, + Size:?bits(?ST_SIZE_SIZE)/integer-little>>, + Elf, StrTab) -> + mk_sym(get_strtab_entry(Name, StrTab), decode_symbol_bind(?ELF_ST_BIND(Info)), + decode_symbol_type(?ELF_ST_TYPE(Info)), elf_section(Shndx, Elf), Value, + Size). +-endif. + +decode_symbol_bind(?STB_LOCAL) -> 'local'; +decode_symbol_bind(?STB_GLOBAL) -> 'global'; +decode_symbol_bind(?STB_WEAK) -> 'weak'; %unused +decode_symbol_bind(OS) when ?STB_LOOS =< OS, OS =< ?STB_HIOS -> {os, OS}; +decode_symbol_bind(Proc) when ?STB_LOPROC =< Proc, Proc =< ?STB_HIPROC -> + {proc, Proc}. + +decode_symbol_type(?STT_NOTYPE) -> 'notype'; +decode_symbol_type(?STT_OBJECT) -> 'object'; +decode_symbol_type(?STT_FUNC) -> 'func'; +decode_symbol_type(?STT_SECTION) -> 'section'; +decode_symbol_type(?STT_FILE) -> 'file'; +decode_symbol_type(OS) when ?STT_LOOS =< OS, OS =< ?STT_HIOS -> {os, OS}; +decode_symbol_type(Proc) when ?STT_LOPROC =< Proc, Proc =< ?STT_HIPROC -> + {proc, Proc}. + +%% @doc Extracts a specific entry from the Symbol Table. +-spec elf_symbol(0, elf()) -> undefined; + (pos_integer(), elf()) -> elf_sym(). +elf_symbol(0, #elf{}) -> undefined; +elf_symbol(Index, #elf{symbols=Symbols}) -> lists:nth(Index, Symbols). + +-spec elf_symbols(elf()) -> [elf_sym()]. +elf_symbols(#elf{symbols=Symbols}) -> Symbols. + +%%------------------------------------------------------------------------------ +%% Functions to manipulate String Table +%%------------------------------------------------------------------------------ + +%% ADT: get_strtab_entry/1 must be used to consume this type. +-type strtab() :: binary(). + +%% @doc Extracts String Table from an ELF formated Object File. +-spec extract_strtab(elf()) -> strtab(). +extract_strtab(Elf) -> + parse_strtab(extract_segment_by_name(Elf, ?STRTAB)). + +-spec parse_strtab(binary()) -> strtab(). +parse_strtab(StrTabSectionBin) -> StrTabSectionBin. + +%% @doc Returns the name of the symbol at the given offset. +-spec get_strtab_entry(non_neg_integer(), strtab()) -> string(). +get_strtab_entry(Offset, StrTab) -> + <<_:Offset/binary, StrBin/binary>> = StrTab, + bin_get_string(StrBin). + +%% @doc Extracts a null-terminated string from a binary. +-spec bin_get_string(binary()) -> string(). +%% FIXME: No regard for encoding (just happens to work for ASCII and Latin-1) +bin_get_string(<<0, _/binary>>) -> []; +bin_get_string(<<Char, Rest/binary>>) -> [Char|bin_get_string(Rest)]. + +%%------------------------------------------------------------------------------ +%% Functions to manipulate Relocations +%%------------------------------------------------------------------------------ + +%% @doc Extract the Relocations segment for section `Name' (that is passed +%% as second argument) from an ELF formated Object file binary. +-spec extract_rela(elf(), name()) -> [elf_rel()]. + +-ifdef(BIT32). +extract_rela(Elf, Name) -> + SecData = extract_segment_by_name(Elf, Name), + [#elf_rel{offset=Offset, symbol=elf_symbol(?ELF_R_SYM(Info), Elf), + type=decode_reloc_type(?ELF_R_TYPE(Info)), + addend=read_implicit_addend(Offset, SecData)} + || <<Offset:?bits(?R_OFFSET_SIZE)/little, + Info:?bits(?R_INFO_SIZE)/little % 386 uses ".rel" + >> <= extract_segment_by_name(Elf, ?REL(Name))]. + +%% The only types HiPE knows how to patch +decode_reloc_type(1) -> '32'; +decode_reloc_type(2) -> 'pc32'. + +read_implicit_addend(Offset, Section) -> + %% All x86 relocation types uses 'word32' relocation fields; i.e. 32-bit LE. + <<_:Offset/binary, Addend:32/signed-little, _/binary>> = Section, + Addend. + +-else. %% BIT32 +extract_rela(Elf, Name) -> + [#elf_rel{offset=Offset, symbol=elf_symbol(?ELF_R_SYM(Info), Elf), + type=decode_reloc_type(?ELF_R_TYPE(Info)), addend=Addend} + || <<Offset:?bits(?R_OFFSET_SIZE)/little, + Info:?bits(?R_INFO_SIZE)/little, + Addend:?bits(?R_ADDEND_SIZE)/signed-little % X86_64 uses ".rela" + >> <= extract_segment_by_name(Elf, ?RELA(Name))]. + +decode_reloc_type(1) -> '64'; +decode_reloc_type(2) -> 'pc32'; +decode_reloc_type(10) -> '32'. +-endif. %% BIT32 + +%%------------------------------------------------------------------------------ +%% Functions to manipulate Executable Code segment +%%------------------------------------------------------------------------------ + +%% @doc This function gets as arguments an ELF formated binary file and +%% returns the Executable Code (".text" segment) or an empty binary if it +%% is not found. +-spec extract_text(elf()) -> binary(). +extract_text(Elf) -> + extract_segment_by_name(Elf, ?TEXT). + +%%------------------------------------------------------------------------------ +%% Functions to manipulate Note Section +%%------------------------------------------------------------------------------ + +%% @doc Extract specific Note Section from an ELF Object file. The function +%% takes as first argument the object file (`Elf') and the `Name' of the +%% wanted Note Section (<b>without</b> the ".note" prefix!). It returns +%% the specified binary segment or an empty binary if no such section +%% exists. +-spec extract_note(elf(), string()) -> binary(). +extract_note(Elf, Name) -> + extract_segment_by_name(Elf, ?NOTE(Name)). + +%%------------------------------------------------------------------------------ +%% Functions to manipulate GCC Exception Table segment +%%------------------------------------------------------------------------------ + +%% A description for the C++ exception table formats can be found at Exception +%% Handling Tables (http://www.codesourcery.com/cxx-abi/exceptions.pdf). + +%% A list with `{Start, End, HandlerOffset}' for all call sites in the code +-spec get_exn_handlers(elf()) -> [{start(), start(), lp()}]. +get_exn_handlers(Elf) -> + CallSites = extract_gccexntab_callsites(Elf), + [{Start, Start + Size, LP} + || #elf_gccexntab_callsite{start = Start, size = Size, lp = LP} <- CallSites]. + +%% @doc This function gets as argument an ELF binary file and returns +%% the table (list) of call sites which is stored in GCC +%% Exception Table (".gcc_except_table") section. +%% It returns an empty list if the Exception Table is not found. +%% XXX: Assumes there is *no* Action Record Table. +extract_gccexntab_callsites(Elf) -> + case extract_segment_by_name(Elf, ?GCC_EXN_TAB) of + <<>> -> + []; + ExnTab -> + %% First byte of LSDA is Landing Pad base encoding. + <<LBenc:8, More/binary>> = ExnTab, + %% Second byte is the Landing Pad base (if its encoding is not + %% DW_EH_PE_omit) (optional). + {_LPBase, LSDACont} = + case LBenc =:= ?DW_EH_PE_omit of + true -> % No landing pad base byte. (-1 denotes that) + {-1, More}; + false -> % Landing pad base. + <<Base:8, More2/binary>> = More, + {Base, More2} + end, + %% Next byte of LSDA is the encoding of the Type Table. + <<TTenc:8, More3/binary>> = LSDACont, + %% Next byte is the Types Table offset encoded in U-LEB128 (optional). + {_TTOff, LSDACont2} = + case TTenc =:= ?DW_EH_PE_omit of + true -> % There is no Types Table pointer. (-1 denotes that) + {-1, More3}; + false -> % The byte offset from this field to the start of the Types + % Table used for exception matching. + leb128_decode(More3) + end, + %% Next byte of LSDA is the encoding of the fields in the Call-site Table. + <<_CSenc:8, More4/binary>> = LSDACont2, + %% Sixth byte is the size (in bytes) of the Call-site Table encoded in + %% U-LEB128. + {_CSTabSize, CSTab} = leb128_decode(More4), + %% Extract all call site information + get_gccexntab_callsites(CSTab, []) + end. + +get_gccexntab_callsites(<<>>, Acc) -> + lists:reverse(Acc); +get_gccexntab_callsites(CSTab, Acc) -> + %% We are only interested in the Landing Pad of every entry. + <<Start:32/integer-little, Size:32/integer-little, + LP:32/integer-little, OnAction:8, More/binary + >> = CSTab, + GccCS = mk_gccexntab_callsite(Start, Size, LP, OnAction), + get_gccexntab_callsites(More, [GccCS | Acc]). + +%%------------------------------------------------------------------------------ +%% Helper functions +%%------------------------------------------------------------------------------ + +%% @doc Returns the binary segment starting at `Offset' with length `Size' +%% (bytes) from a binary file. If `Offset' is bigger than the byte size of +%% the binary, an empty binary (`<<>>') is returned. +-spec get_binary_segment(binary(), offset(), size()) -> binary(). +get_binary_segment(Bin, Offset, _Size) when Offset > byte_size(Bin) -> + <<>>; +get_binary_segment(Bin, Offset, Size) -> + <<_Hdr:Offset/binary, BinSeg:Size/binary, _More/binary>> = Bin, + BinSeg. + +%% @doc This function gets as arguments an ELF formated binary object and +%% a string with the segments' name and returns the specified segment or +%% an empty binary (`<<>>') if there exists no segment with that name. +%% There are handy macros defined in elf_format.hrl for all Standard +%% Section Names. +-spec extract_segment_by_name(elf(), string()) -> binary(). +extract_segment_by_name(#elf{file=ElfBin, sec_nam=SecNam}, SectionName) -> + %% Find Section Header Table entry by name + case SecNam of + #{SectionName := #elf_shdr{offset=Offset, size=Size}} -> + get_binary_segment(ElfBin, Offset, Size); + #{} -> %% Not found. + <<>> + end. + +%% @doc Little-Endian Base 128 (LEB128) Decoder +%% This function extracts the <b>first</b> LEB128-encoded integer in a +%% binary and returns that integer along with the remaining binary. This is +%% done because a LEB128 number has variable bit-size and that is a way of +%% extracting only one number in a binary and continuing parsing the binary +%% for other kind of data (e.g. different encoding). +%% FIXME: Only decodes unsigned data! +-spec leb128_decode(binary()) -> {integer(), binary()}. +leb128_decode(LebNum) -> + leb128_decode(LebNum, 0, <<>>). + +-spec leb128_decode(binary(), integer(), binary()) -> {integer(), binary()}. +leb128_decode(LebNum, NoOfBits, Acc) -> + <<Sentinel:1/bits, NextBundle:7/bits, MoreLebNums/bits>> = LebNum, + case Sentinel of + <<1:1>> -> % more bytes to follow + leb128_decode(MoreLebNums, NoOfBits+7, <<NextBundle:7/bits, Acc/bits>>); + <<0:1>> -> % byte bundle stop + Size = NoOfBits+7, + <<Num:Size/integer>> = <<NextBundle:7/bits, Acc/bits>>, + {Num, MoreLebNums} + end. diff --git a/lib/hipe/llvm/elf_format.hrl b/lib/hipe/llvm/elf_format.hrl new file mode 100644 index 0000000000..57a36f0c3e --- /dev/null +++ b/lib/hipe/llvm/elf_format.hrl @@ -0,0 +1,528 @@ +%% -*- erlang-indent-level: 2 -*- + +%%% @copyright 2011-2014 Yiannis Tsiouris <[email protected]>, +%%% Chris Stavrakakis <[email protected]> +%%% @author Yiannis Tsiouris <[email protected]> +%%% [http://www.softlab.ntua.gr/~gtsiour/] + +%%------------------------------------------------------------------------------ +%% +%% ELF Header File +%% +%%------------------------------------------------------------------------------ + +-ifdef(BIT32). +-include("elf32_format.hrl"). % ELF32-specific definitions. +-else. +-include("elf64_format.hrl"). % ELF64-specific definitions. +-endif. + +%%------------------------------------------------------------------------------ +%% ELF Data Types (in bytes) +%%------------------------------------------------------------------------------ +%%XXX: Included in either elf32_format or elf64_format. + +%%------------------------------------------------------------------------------ +%% ELF File Header +%%------------------------------------------------------------------------------ +-define(ELF_EHDR_SIZE, (?E_IDENT_SIZE + ?E_TYPE_SIZE + ?E_MACHINE_SIZE + +?E_VERSION_SIZE + ?E_ENTRY_SIZE + ?E_PHOFF_SIZE + +?E_SHOFF_SIZE + ?E_FLAGS_SIZE + ?E_EHSIZE_SIZE + +?E_PHENTSIZE_SIZE + ?E_PHNUM_SIZE + ?E_SHENTSIZE_SIZE + +?E_SHNUM_SIZE + ?E_SHSTRNDX_SIZE) ). + +-define(E_IDENT_SIZE, (16 * ?ELF_UNSIGNED_CHAR_SIZE) ). +-define(E_TYPE_SIZE, ?ELF_HALF_SIZE). +-define(E_MACHINE_SIZE, ?ELF_HALF_SIZE). +-define(E_VERSION_SIZE, ?ELF_WORD_SIZE). +-define(E_ENTRY_SIZE, ?ELF_ADDR_SIZE). +-define(E_PHOFF_SIZE, ?ELF_OFF_SIZE). +-define(E_SHOFF_SIZE, ?ELF_OFF_SIZE). +-define(E_FLAGS_SIZE, ?ELF_WORD_SIZE). +-define(E_EHSIZE_SIZE, ?ELF_HALF_SIZE). +-define(E_PHENTSIZE_SIZE, ?ELF_HALF_SIZE). +-define(E_PHNUM_SIZE, ?ELF_HALF_SIZE). +-define(E_SHENTSIZE_SIZE, ?ELF_HALF_SIZE). +-define(E_SHNUM_SIZE, ?ELF_HALF_SIZE). +-define(E_SHSTRNDX_SIZE, ?ELF_HALF_SIZE). + +%% Useful arithmetics for computing byte offsets for various File Header +%% entries from a File Header (erlang) binary +-define(E_IDENT_OFFSET, 0). +-define(E_TYPE_OFFSET, (?E_IDENT_OFFSET + ?E_IDENT_SIZE) ). +-define(E_MACHINE_OFFSET, (?E_TYPE_OFFSET + ?E_TYPE_SIZE) ). +-define(E_VERSION_OFFSET, (?E_MACHINE_OFFSET + ?E_MACHINE_SIZE) ). +-define(E_ENTRY_OFFSET, (?E_VERSION_OFFSET + ?E_VERSION_SIZE) ). +-define(E_PHOFF_OFFSET, (?E_ENTRY_OFFSET + ?E_ENTRY_SIZE) ). +-define(E_SHOFF_OFFSET, (?E_PHOFF_OFFSET + ?E_PHOFF_SIZE) ). +-define(E_FLAGS_OFFSET, (?E_SHOFF_OFFSET + ?E_SHOFF_SIZE) ). +-define(E_EHSIZE_OFFSET, (?E_FLAGS_OFFSET + ?E_FLAGS_SIZE) ). +-define(E_PHENTSIZE_OFFSET, (?E_EHSIZE_OFFSET + ?E_EHSIZE_SIZE) ). +-define(E_PHNUM_OFFSET, (?E_PHENTSIZE_OFFSET + ?E_PHENTSIZE_SIZE) ). +-define(E_SHENTSIZE_OFFSET, (?E_PHNUM_OFFSET + ?E_PHNUM_SIZE) ). +-define(E_SHNUM_OFFSET, (?E_SHENTSIZE_OFFSET + ?E_SHENTSIZE_SIZE) ). +-define(E_SHSTRNDX_OFFSET, (?E_SHNUM_OFFSET + ?E_SHNUM_SIZE) ). + +%% Name aliases of File Header fields information used in get_header_field +%% function of elf64_format module. +-define(E_IDENT, {?E_IDENT_OFFSET, ?E_IDENT_SIZE}). +-define(E_TYPE, {?E_TYPE_OFFSET, ?E_TYPE_SIZE}). +-define(E_MACHINE, {?E_MACHINE_OFFSET, ?E_MACHINE_SIZE}). +-define(E_VERSION, {?E_VERSION_OFFSET, ?E_VERSION_SIZE}). +-define(E_ENTRY, {?E_ENTRY_OFFSET, ?E_ENTRY_SIZE}). +-define(E_PHOFF, {?E_PHOFF_OFFSET, ?E_PHOFF_SIZE}). +-define(E_SHOFF, {?E_SHOFF_OFFSET, ?E_SHOFF_SIZE}). +-define(E_FLAGS, {?E_FLAGS_OFFSET, ?E_FLAGS_SIZE}). +-define(E_EHSIZE, {?E_EHSIZE_OFFSET, ?E_EHSIZE_SIZE}). +-define(E_PHENTSIZE, {?E_PHENTSIZE_OFFSET, ?E_PHENTSIZE_SIZE}). +-define(E_PHNUM, {?E_PHNUM_OFFSET, ?E_PHNUM_SIZE}). +-define(E_SHENTSIZE, {?E_SHENTSIZE_OFFSET, ?E_SHENTSIZE_SIZE}). +-define(E_SHNUM, {?E_SHNUM_OFFSET, ?E_SHNUM_SIZE}). +-define(E_SHSTRNDX, {?E_SHSTRNDX_OFFSET, ?E_SHSTRNDX_SIZE}). + +%% ELF Identification (e_ident) +-define(EI_MAG0, 0). +-define(EI_MAG1, 1). +-define(EI_MAG2, 2). +-define(EI_MAG3, 3). +-define(EI_CLASS, 4). +-define(EI_DATA, 5). +-define(EI_VERSION, 6). +-define(EI_OSABI, 7). +-define(EI_ABIVERSION, 8). +-define(EI_PAD, 9). +-define(EI_NIDENT, 16). + +%% Object File Classes (e_ident[EI_CLASS]) +-define(ELFCLASSNONE, 0). +-define(ELFCLASS32, 1). +-define(ELFCLASS64, 2). + +%% Data Encodings (e_ident[EI_DATA]) +-define(ELFDATA2LSB, 1). +-define(ELFDATA2MSB, 2). + +%% Operating System and ABI Identifiers (e_ident[EI_OSABI]) +-define(ELFOSABI_SYSV, 0). +-define(ELFOSABI_HPUX, 1). +-define(ELFOSABI_STANDALONE, 255). + +%% Object File Types (e_type) +-define(ET_NONE, 0). +-define(ET_REL, 1). +-define(ET_EXEC, 2). +-define(ET_DYN, 3). +-define(ET_CORE, 4). +-define(ET_LOOS, 16#FE00). +-define(ET_HIOS, 16#FEFF). +-define(ET_LOPROC, 16#FF00). +-define(ET_HIPROC, 16#FFFF). + +%%------------------------------------------------------------------------------ +%% ELF Section Header +%%------------------------------------------------------------------------------ +-define(ELF_SHDRENTRY_SIZE, (?SH_NAME_SIZE + ?SH_TYPE_SIZE + ?SH_FLAGS_SIZE + +?SH_ADDR_SIZE + ?SH_OFFSET_SIZE + ?SH_SIZE_SIZE + +?SH_LINK_SIZE + ?SH_INFO_SIZE + +?SH_ADDRALIGN_SIZE + ?SH_ENTSIZE_SIZE) ). + +-define(SH_NAME_SIZE, ?ELF_WORD_SIZE). +-define(SH_TYPE_SIZE, ?ELF_WORD_SIZE). +-define(SH_FLAGS_SIZE, ?ELF_XWORD_SIZE). +-define(SH_ADDR_SIZE, ?ELF_ADDR_SIZE). +-define(SH_OFFSET_SIZE, ?ELF_OFF_SIZE). +-define(SH_SIZE_SIZE, ?ELF_XWORD_SIZE). +-define(SH_LINK_SIZE, ?ELF_WORD_SIZE). +-define(SH_INFO_SIZE, ?ELF_WORD_SIZE). +-define(SH_ADDRALIGN_SIZE, ?ELF_XWORD_SIZE). +-define(SH_ENTSIZE_SIZE, ?ELF_XWORD_SIZE). + +%% Useful arithmetics for computing byte offsets for various fields from a +%% Section Header Entry (erlang) binary +-define(SH_NAME_OFFSET, 0). +-define(SH_TYPE_OFFSET, (?SH_NAME_OFFSET + ?SH_NAME_SIZE) ). +-define(SH_FLAGS_OFFSET, (?SH_TYPE_OFFSET + ?SH_TYPE_SIZE) ). +-define(SH_ADDR_OFFSET, (?SH_FLAGS_OFFSET + ?SH_FLAGS_SIZE) ). +-define(SH_OFFSET_OFFSET, (?SH_ADDR_OFFSET + ?SH_ADDR_SIZE) ). +-define(SH_SIZE_OFFSET, (?SH_OFFSET_OFFSET + ?SH_OFFSET_SIZE) ). +-define(SH_LINK_OFFSET, (?SH_SIZE_OFFSET + ?SH_SIZE_SIZE) ). +-define(SH_INFO_OFFSET, (?SH_LINK_OFFSET + ?SH_LINK_SIZE) ). +-define(SH_ADDRALIGN_OFFSET, (?SH_INFO_OFFSET + ?SH_INFO_SIZE) ). +-define(SH_ENTSIZE_OFFSET, (?SH_ADDRALIGN_OFFSET + ?SH_ADDRALIGN_SIZE) ). + +%% Name aliases of Section Header Table entry information used in +%% get_shdrtab_entry function of elf64_format module. +-define(SH_NAME, {?SH_NAME_OFFSET, ?SH_NAME_SIZE}). +-define(SH_TYPE, {?SH_TYPE_OFFSET, ?SH_TYPE_SIZE}). +-define(SH_FLAGS, {?SH_FLAGS_OFFSET, ?SH_FLAGS_SIZE}). +-define(SH_ADDR, {?SH_ADDR_OFFSET, ?SH_ADDR_SIZE}). +-define(SH_OFFSET, {?SH_OFFSET_OFFSET, ?SH_OFFSET_SIZE}). +-define(SH_SIZE, {?SH_SIZE_OFFSET, ?SH_SIZE_SIZE}). +-define(SH_LINK, {?SH_LINK_OFFSET, ?SH_LINK_SIZE}). +-define(SH_INFO, {?SH_INFO_OFFSET, ?SH_INFO_SIZE}). +-define(SH_ADDRALIGN, {?SH_ADDRALIGN_OFFSET, ?SH_ADDRALIGN_SIZE}). +-define(SH_ENTSIZE, {?SH_ENTSIZE_OFFSET, ?SH_ENTSIZE_SIZE}). + +%% Section Indices +-define(SHN_UNDEF, 0). +-define(SHN_LOPROC, 16#FF00). +-define(SHN_HIPROC, 16#FF1F). +-define(SHN_LOOS, 16#FF20). +-define(SHN_HIOS, 16#FF3F). +-define(SHN_ABS, 16#FFF1). +-define(SHN_COMMON, 16#FFF2). + +%% Section Types (sh_type) +-define(SHT_NULL, 0). +-define(SHT_PROGBITS, 1). +-define(SHT_SYMTAB, 2). +-define(SHT_STRTAB, 3). +-define(SHT_RELA, 4). +-define(SHT_HASH, 5). +-define(SHT_DYNAMIC, 6). +-define(SHT_NOTE, 7). +-define(SHT_NOBITS, 8). +-define(SHT_REL, 9). +-define(SHT_SHLIB, 10). +-define(SHT_DYNSYM, 11). +-define(SHT_LOOS, 16#60000000). +-define(SHT_HIOS, 16#6FFFFFFF). +-define(SHT_LOPROC, 16#70000000). +-define(SHT_HIPROC, 16#7FFFFFFF). + +%% Section Attributes (sh_flags) +-define(SHF_WRITE, 16#1). +-define(SHF_ALLOC, 16#2). +-define(SHF_EXECINSTR, 16#4). +-define(SHF_MASKOS, 16#0F000000). +-define(SHF_MASKPROC, 16#F0000000). + +%% +%% Standard Section names for Code and Data +%% +-define(BSS, ".bss"). +-define(DATA, ".data"). +-define(INTERP, ".interp"). +-define(RODATA, ".rodata"). +-define(TEXT, ".text"). +%% Other Standard Section names +-define(COMMENT, ".comment"). +-define(DYNAMIC, ".dynamic"). +-define(DYNSTR, ".dynstr"). +-define(GOT, ".got"). +-define(HASH, ".hash"). +-define(NOTE(Name), (".note" ++ Name)). +-define(PLT, ".plt"). +-define(REL(Name), (".rel" ++ Name) ). +-define(RELA(Name), (".rela" ++ Name) ). +-define(SHSTRTAB, ".shstrtab"). +-define(STRTAB, ".strtab"). +-define(SYMTAB, ".symtab"). +-define(GCC_EXN_TAB, ".gcc_except_table"). + +%%------------------------------------------------------------------------------ +%% ELF Symbol Table Entries +%%------------------------------------------------------------------------------ +-define(ELF_SYM_SIZE, (?ST_NAME_SIZE + ?ST_INFO_SIZE + ?ST_OTHER_SIZE + +?ST_SHNDX_SIZE + ?ST_VALUE_SIZE + ?ST_SIZE_SIZE) ). + +-define(ST_NAME_SIZE, ?ELF_WORD_SIZE). +-define(ST_INFO_SIZE, ?ELF_UNSIGNED_CHAR_SIZE). +-define(ST_OTHER_SIZE, ?ELF_UNSIGNED_CHAR_SIZE). +-define(ST_SHNDX_SIZE, ?ELF_HALF_SIZE). +-define(ST_VALUE_SIZE, ?ELF_ADDR_SIZE). +-define(ST_SIZE_SIZE, ?ELF_XWORD_SIZE). + +%% Precomputed offset for Symbol Table entries in SymTab binary +%%XXX: Included in either elf32_format or elf64_format. + +%% Name aliases for Symbol Table entry information +-define(ST_NAME, {?ST_NAME_OFFSET, ?ST_NAME_SIZE}). +-define(ST_INFO, {?ST_INFO_OFFSET, ?ST_INFO_SIZE}). +-define(ST_OTHER, {?ST_OTHER_OFFSET, ?ST_OTHER_SIZE}). +-define(ST_SHNDX, {?ST_SHNDX_OFFSET, ?ST_SHNDX_SIZE}). +-define(ST_VALUE, {?ST_VALUE_OFFSET, ?ST_VALUE_SIZE}). +-define(ST_SIZE, {?ST_SIZE_OFFSET, ?ST_SIZE_SIZE}). + +%% Macros to extract information from st_type +-define(ELF_ST_BIND(I), (I bsr 4) ). +-define(ELF_ST_TYPE(I), (I band 16#f) ). +-define(ELF_ST_INFO(B,T), (B bsl 4 + T band 16#f) ). + +%% Symbol Bindings +-define(STB_LOCAL, 0). +-define(STB_GLOBAL, 1). +-define(STB_WEAK, 2). +-define(STB_LOOS, 10). +-define(STB_HIOS, 12). +-define(STB_LOPROC, 13). +-define(STB_HIPROC, 15). + +%% Symbol Types +-define(STT_NOTYPE, 0). +-define(STT_OBJECT, 1). +-define(STT_FUNC, 2). +-define(STT_SECTION, 3). +-define(STT_FILE, 4). +-define(STT_LOOS, 10). +-define(STT_HIOS, 12). +-define(STT_LOPROC, 13). +-define(STT_HIPROC, 15). + +%%------------------------------------------------------------------------------ +%% ELF Relocation Entries +%%------------------------------------------------------------------------------ +-define(ELF_REL_SIZE, (?R_OFFSET_SIZE + ?R_INFO_SIZE) ). +-define(ELF_RELA_SIZE, (?R_OFFSET_SIZE + ?R_INFO_SIZE + ?R_ADDEND_SIZE) ). + +-define(R_OFFSET_SIZE, ?ELF_ADDR_SIZE). +-define(R_INFO_SIZE, ?ELF_XWORD_SIZE). +-define(R_ADDEND_SIZE, ?ELF_SXWORD_SIZE). + +%% Arithmetics for computing byte offsets in a Relocation entry binary +-define(R_OFFSET_OFFSET, 0). +-define(R_INFO_OFFSET, (?R_OFFSET_OFFSET + ?R_OFFSET_SIZE) ). +-define(R_ADDEND_OFFSET, (?R_INFO_OFFSET + ?R_INFO_SIZE) ). + +%% Name aliases for Relocation field information +-define(R_OFFSET, {?R_OFFSET_OFFSET, ?R_OFFSET_SIZE}). +-define(R_INFO, {?R_INFO_OFFSET, ?R_INFO_SIZE}). +-define(R_ADDEND, {?R_ADDEND_OFFSET, ?R_ADDEND_SIZE}). + +%% Useful macros to extract information from r_info field +%%XXX: Included in either elf32_format or elf64_format. + +%%------------------------------------------------------------------------------ +%% ELF Program Header Table +%%------------------------------------------------------------------------------ +-define(ELF_PHDR_SIZE, (?P_TYPE_SIZE + ?P_FLAGS_SIZE + ?P_OFFSET_SIZE + +?P_VADDR_SIZE + ?P_PADDR_SIZE + ?P_FILESZ_SIZE + +?P_MEMSZ_SIZE + ?P_ALIGN_SIZE) ). + +-define(P_TYPE_SIZE, ?ELF_WORD_SIZE). +-define(P_FLAGS_SIZE, ?ELF_WORD_SIZE). +-define(P_OFFSET_SIZE, ?ELF_OFF_SIZE). +-define(P_VADDR_SIZE, ?ELF_ADDR_SIZE). +-define(P_PADDR_SIZE, ?ELF_ADDR_SIZE). +-define(P_FILESZ_SIZE, ?ELF_XWORD_SIZE). +-define(P_MEMSZ_SIZE, ?ELF_XWORD_SIZE). +-define(P_ALIGN_SIZE, ?ELF_XWORD_SIZE). + +%% Offsets of various fields in a Program Header Table entry binary. +%%XXX: Included in either elf32_format or elf64_format. + +%% Name aliases for each Program Header Table entry field information. +-define(P_TYPE, {?P_TYPE_OFFSET, ?P_TYPE_SIZE} ). +-define(P_FLAGS, {?P_FLAGS_OFFSET, ?P_FLAGS_SIZE} ). +-define(P_OFFSET, {?P_OFFSET_OFFSET, ?P_OFFSET_SIZE} ). +-define(P_VADDR, {?P_VADDR_OFFSET, ?P_VADDR_SIZE} ). +-define(P_PADDR, {?P_PADDR_OFFSET, ?P_PADDR_SIZE} ). +-define(P_FILESZ, {?P_FILESZ_OFFSET, ?P_FILESZ_SIZE} ). +-define(P_MEMSZ, {?P_MEMSZ_OFFSET, ?P_MEMSZ_SIZE} ). +-define(P_ALIGN, {?P_ALIGN_OFFSET, ?P_ALIGN_SIZE} ). + +%% Segment Types (p_type) +-define(PT_NULL, 0). +-define(PT_LOAD, 1). +-define(PT_DYNAMIC, 2). +-define(PT_INTERP, 3). +-define(PT_NOTE, 4). +-define(PT_SHLIB, 5). +-define(PT_PHDR, 6). +-define(PT_LOOS, 16#60000000). +-define(PT_HIOS, 16#6FFFFFFF). +-define(PT_LOPROC, 16#70000000). +-define(PT_HIPROC, 16#7FFFFFFF). + +%% Segment Attributes (p_flags) +-define(PF_X, 16#1). +-define(PF_W, 16#2). +-define(PF_R, 16#4). +-define(PF_MASKOS, 16#00FF0000). +-define(PF_MASKPROC, 16#FF000000). + +%%------------------------------------------------------------------------------ +%% ELF Dynamic Table +%%------------------------------------------------------------------------------ +-define(ELF_DYN_SIZE, (?D_TAG_SIZE + ?D_VAL_PTR_SIZE) ). + +-define(D_TAG_SIZE, ?ELF_SXWORD_SIZE). +-define(D_VAL_PTR_SIZE, ?ELF_ADDR_SIZE). + +%% Offsets of each field in Dynamic Table entry in binary +-define(D_TAG_OFFSET, 0). +-define(D_VAL_PTR_OFFSET, (?D_TAG_OFFSET + ?D_TAG_SIZE)). + +%% Name aliases for each field of a Dynamic Table entry information +-define(D_TAG, {?D_TAG_OFFSET, ?D_TAG_SIZE} ). +-define(D_VAL_PTR, {?D_VAL_PTR_OFFSET, ?D_VAL_PTR_SIZE} ). + +%% Dynamic Table Entries +-define(DT_NULL, 0). +-define(DT_NEEDED, 1). +-define(DT_PLTRELSZ, 2). +-define(DT_PLTGOT, 3). +-define(DT_HASH, 4). +-define(DT_STRTAB, 5). +-define(DT_SYMTAB, 6). +-define(DT_RELA, 7). +-define(DT_RELASZ, 8). +-define(DT_RELAENT, 9). +-define(DT_STRSZ, 10). +-define(DT_SYMENT, 11). +-define(DT_INIT, 12). +-define(DT_FINI, 13). +-define(DT_SONAME, 14). +-define(DT_RPATH, 15). +-define(DT_SYMBOLIC, 16). +-define(DT_REL, 17). +-define(DT_RELSZ, 18). +-define(DT_RELENT, 19). +-define(DT_PLTREL, 20). +-define(DT_DEBUG, 21). +-define(DT_TEXTREL, 22). +-define(DT_JMPREL, 23). +-define(DT_BIND_NOW, 24). +-define(DT_INIT_ARRAY, 25). +-define(DT_FINI_ARRAY, 26). +-define(DT_INIT_ARRAYSZ, 27). +-define(DT_FINI_ARRAYSZ, 28). +-define(DT_LOOS, 16#60000000). +-define(DT_HIOS, 16#6FFFFFFF). +-define(DT_LOPROC, 16#700000000). +-define(DT_HIPROC, 16#7FFFFFFFF). + +%%------------------------------------------------------------------------------ +%% ELF GCC Exception Table +%%------------------------------------------------------------------------------ + +%% The DWARF Exception Header Encoding is used to describe the type of data used +%% in the .eh_frame_hdr (and .gcc_except_table) section. The upper 4 bits +%% indicate how the value is to be applied. The lower 4 bits indicate the format +%% of the data. + +%% DWARF Exception Header value format +-define(DW_EH_PE_omit, 16#ff). % No value is present. +-define(DW_EH_PE_uleb128, 16#01). % Unsigned value encoded using LEB128. +-define(DW_EH_PE_udata2, 16#02). % A 2 bytes unsigned value. +-define(DW_EH_PE_udata4, 16#03). % A 4 bytes unsigned value. +-define(DW_EH_PE_udata8, 16#04). % An 8 bytes unsigned value. +-define(DW_EH_PE_sleb128, 16#09). % Signed value encoded using LEB128. +-define(DW_EH_PE_sdata2, 16#0a). % A 2 bytes signed value. +-define(DW_EH_PE_sdata4, 16#0b). % A 4 bytes signed value. +-define(DW_EH_PE_sdata8, 16#0c). % An 8 bytes signed value. + +%% DWARF Exception Header application +-define(DW_EH_PE_absptr, 16#00). % Value is used with no modification. +-define(DW_EH_PE_pcrel, 16#10). % Value is relative to the current PC. +-define(DW_EH_PE_datarel, 16#30). % Value is relative to the beginning of the + % section. + +%%------------------------------------------------------------------------------ +%% ELF Read-only data (constants, literlas etc.) +%%------------------------------------------------------------------------------ +-define(RO_ENTRY_SIZE, 8). + +%%------------------------------------------------------------------------------ +%% Custom Note section: ".note.gc" for Erlang GC +%%------------------------------------------------------------------------------ + +%% The structure of this section is the following: +%% +%% .short <n> # number of safe points in code +%% +%% .long .L<label1> # safe point address | +%% .long .L<label2> # safe point address |-> safe point addrs +%% ..... | +%% .long .L<label3> # safe point address | +%% +%% .short <n> # stack frame size (in words) |-> fixed-size part +%% .short <n> # stack arity | +%% .short <n> # number of live roots that follow | +%% +%% .short <n> # live root's stack index | +%% ..... |-> live root indices +%% .short <n> # >> | + +%% The name of the custom Note Section +-define(NOTE_ERLGC_NAME, ".gc"). + +%% The first word of a Note Section for Erlang GC (".note.gc") is always the +%% number of safepoints in code. +-define(SP_COUNT, {?SP_COUNT_OFFSET, ?SP_COUNT_SIZE}). +-define(SP_COUNT_SIZE, ?ELF_HALF_SIZE). +-define(SP_COUNT_OFFSET, 0). %(always the first entry in sdesc) + +%% The fixed-size part of a safe point (SP) entry consists of 4 words: the SP +%% address (offset in code), the stack frame size of the function (where the SP +%% is located), the stack arity of the function (the registered values are *not* +%% counted), the number of live roots in the specific SP. +-define(SP_FIXED, {?SP_FIXED_OFF, ?SP_FIXED_SIZE}). +-define(SP_FIXED_OFF, 0). +%%XXX: Exclude SP_ADDR_SIZE from SP_FIXED_SIZE in lew of new GC layout +-define(SP_FIXED_SIZE, (?SP_STKFRAME_SIZE + ?SP_STKARITY_SIZE + + ?SP_LIVEROOTCNT_SIZE)). + +-define(SP_ADDR_SIZE, ?ELF_WORD_SIZE). +-define(SP_STKFRAME_SIZE, ?ELF_HALF_SIZE). +-define(SP_STKARITY_SIZE, ?ELF_HALF_SIZE). +-define(SP_LIVEROOTCNT_SIZE, ?ELF_HALF_SIZE). + +%%XXX: SP_STKFRAME is the first piece of information in the new GC layout +-define(SP_STKFRAME_OFFSET, 0). +-define(SP_STKARITY_OFFSET, (?SP_STKFRAME_OFFSET + ?SP_STKFRAME_SIZE) ). +-define(SP_LIVEROOTCNT_OFFSET, (?SP_STKARITY_OFFSET + ?SP_STKARITY_SIZE) ). + +%% Name aliases for safepoint fields. +-define(SP_STKFRAME, {?SP_STKFRAME_OFFSET, ?SP_STKFRAME_SIZE}). +-define(SP_STKARITY, {?SP_STKARITY_OFFSET, ?SP_STKARITY_SIZE}). +-define(SP_LIVEROOTCNT, {?SP_LIVEROOTCNT_OFFSET, ?SP_LIVEROOTCNT_SIZE}). + +%% After the fixed-size part a variable-size part exists. This part holds the +%% stack frame index of every live root in the specific SP. +-define(LR_STKINDEX_SIZE, ?ELF_HALF_SIZE). + +%%------------------------------------------------------------------------------ +%% Misc. +%%------------------------------------------------------------------------------ +-define(bits(Bytes), ((Bytes) bsl 3)). + +%%------------------------------------------------------------------------------ +%% Exported record and type declarations for 'elf_format' module +%%------------------------------------------------------------------------------ + +%% Section header entries +-record(elf_shdr, + {name :: elf_format:name() % Section name + ,type :: elf_format:shdr_type() % Section type + ,flags :: elf_format:bitflags() % Section attributes + ,addr :: elf_format:offset() % Virtual address in memory + ,offset :: elf_format:offset() % Offset in file + ,size :: elf_format:size() % Size of section + ,link :: non_neg_integer() % Link to other section + ,info :: non_neg_integer() % Miscellaneous information + ,addralign :: elf_format:size() % Address align boundary + ,entsize :: elf_format:size() % Size of entries, if section has + % table + }). +-type elf_shdr() :: #elf_shdr{}. + +%% Symbol table entries +-record(elf_sym, + {name :: elf_format:name() % Symbol name + ,bind :: elf_format:sym_bind() % Symbol binding + ,type :: elf_format:sym_type() % Symbol type + ,value :: elf_format:valueoff() % Symbol value + ,size :: elf_format:size() % Size of object + ,section :: undefined | abs | elf_shdr() + }). +-type elf_sym() :: #elf_sym{}. + +%% Relocations +-record(elf_rel, + {offset :: elf_format:offset() + ,type :: elf_format:reloc_type() + ,addend :: elf_format:addend() + ,symbol :: elf_sym() + }). +-type elf_rel() :: #elf_rel{}. diff --git a/lib/hipe/llvm/hipe_llvm.erl b/lib/hipe/llvm/hipe_llvm.erl new file mode 100644 index 0000000000..b22f8fb320 --- /dev/null +++ b/lib/hipe/llvm/hipe_llvm.erl @@ -0,0 +1,1163 @@ +%% -*- erlang-indent-level: 2 -*- + +-module(hipe_llvm). + +-export([ + mk_ret/1, + ret_ret_list/1, + + mk_br/1, + br_dst/1, + + mk_br_cond/3, + mk_br_cond/4, + br_cond_cond/1, + br_cond_true_label/1, + br_cond_false_label/1, + br_cond_meta/1, + + mk_indirectbr/3, + indirectbr_type/1, + indirectbr_address/1, + indirectbr_label_list/1, + + mk_switch/4, + switch_type/1, + switch_value/1, + switch_default_label/1, + switch_value_label_list/1, + + mk_invoke/9, + invoke_dst/1, + invoke_cconv/1, + invoke_ret_attrs/1, + invoke_type/1, + invoke_fnptrval/1, + invoke_arglist/1, + invoke_fn_attrs/1, + invoke_to_label/1, + invoke_unwind_label/1, + + mk_operation/6, + operation_dst/1, + operation_op/1, + operation_type/1, + operation_src1/1, + operation_src2/1, + operation_options/1, + + mk_extractvalue/5, + extractvalue_dst/1, + extractvalue_type/1, + extractvalue_val/1, + extractvalue_idx/1, + extractvalue_idxs/1, + + mk_insertvalue/7, + insertvalue_dst/1, + insertvalue_val_type/1, + insertvalue_val/1, + insertvalue_elem_type/1, + insertvalue_elem/1, + insertvalue_idx/1, + insertvalue_idxs/1, + + mk_alloca/4, + alloca_dst/1, + alloca_type/1, + alloca_num/1, + alloca_align/1, + + mk_load/6, + load_dst/1, + load_p_type/1, + load_pointer/1, + load_alignment/1, + load_nontemporal/1, + load_volatile/1, + + mk_store/7, + store_type/1, + store_value/1, + store_p_type/1, + store_pointer/1, + store_alignment/1, + store_nontemporal/1, + store_volatile/1, + + mk_getelementptr/5, + getelementptr_dst/1, + getelementptr_p_type/1, + getelementptr_value/1, + getelementptr_typed_idxs/1, + getelementptr_inbounds/1, + + mk_conversion/5, + conversion_dst/1, + conversion_op/1, + conversion_src_type/1, + conversion_src/1, + conversion_dst_type/1, + + mk_sitofp/4, + sitofp_dst/1, + sitofp_src_type/1, + sitofp_src/1, + sitofp_dst_type/1, + + mk_ptrtoint/4, + ptrtoint_dst/1, + ptrtoint_src_type/1, + ptrtoint_src/1, + ptrtoint_dst_type/1, + + mk_inttoptr/4, + inttoptr_dst/1, + inttoptr_src_type/1, + inttoptr_src/1, + inttoptr_dst_type/1, + + mk_icmp/5, + icmp_dst/1, + icmp_cond/1, + icmp_type/1, + icmp_src1/1, + icmp_src2/1, + + mk_fcmp/5, + fcmp_dst/1, + fcmp_cond/1, + fcmp_type/1, + fcmp_src1/1, + fcmp_src2/1, + + mk_phi/3, + phi_dst/1, + phi_type/1, + phi_value_label_list/1, + + mk_select/6, + select_dst/1, + select_cond/1, + select_typ1/1, + select_val1/1, + select_typ2/1, + select_val2/1, + + mk_call/8, + call_dst/1, + call_is_tail/1, + call_cconv/1, + call_ret_attrs/1, + call_type/1, + call_fnptrval/1, + call_arglist/1, + call_fn_attrs/1, + + mk_fun_def/10, + fun_def_linkage/1, + fun_def_visibility/1, + fun_def_cconv/1, + fun_def_ret_attrs/1, + fun_def_type/1, + fun_def_name/1, + fun_def_arglist/1, + fun_def_fn_attrs/1, + fun_def_align/1, + fun_def_body/1, + + mk_fun_decl/8, + fun_decl_linkage/1, + fun_decl_visibility/1, + fun_decl_cconv/1, + fun_decl_ret_attrs/1, + fun_decl_type/1, + fun_decl_name/1, + fun_decl_arglist/1, + fun_decl_align/1, + + mk_landingpad/0, + + mk_comment/1, + comment_text/1, + + mk_label/1, + label_label/1, + is_label/1, + + mk_const_decl/4, + const_decl_dst/1, + const_decl_decl_type/1, + const_decl_type/1, + const_decl_value/1, + + mk_asm/1, + asm_instruction/1, + + mk_adj_stack/3, + adj_stack_offset/1, + adj_stack_register/1, + adj_stack_type/1, + + mk_meta/2, + meta_id/1, + meta_operands/1 + ]). + +-export([ + mk_void/0, + + mk_label_type/0, + + mk_int/1, + int_width/1, + + mk_double/0, + + mk_pointer/1, + pointer_type/1, + + mk_array/2, + array_size/1, + array_type/1, + + mk_vector/2, + vector_size/1, + vector_type/1, + + mk_struct/1, + struct_type_list/1, + + mk_fun/2, + function_ret_type/1, + function_arg_type_list/1 + ]). + +-export([pp_ins_list/3, pp_ins/3]). + + +%%----------------------------------------------------------------------------- +%% Abstract Data Types for LLVM Assembly. +%%----------------------------------------------------------------------------- + +%% Terminator Instructions +-record(llvm_ret, {ret_list=[]}). +-type llvm_ret() :: #llvm_ret{}. + +-record(llvm_br, {dst}). +-type llvm_br() :: #llvm_br{}. + +-record(llvm_br_cond, {'cond', true_label, false_label, meta=[]}). +-type llvm_br_cond() :: #llvm_br_cond{}. + +-record(llvm_indirectbr, {type, address, label_list}). +-type llvm_indirectbr() :: #llvm_indirectbr{}. + +-record(llvm_switch, {type, value, default_label, value_label_list=[]}). +-type llvm_switch() :: #llvm_switch{}. + +-record(llvm_invoke, {dst, cconv=[], ret_attrs=[], type, fnptrval, arglist=[], + fn_attrs=[], to_label, unwind_label}). +-type llvm_invoke() :: #llvm_invoke{}. + +%% Binary Operations +-record(llvm_operation, {dst, op, type, src1, src2, options=[]}). +-type llvm_operation() :: #llvm_operation{}. + +%% Aggregate Operations +-record(llvm_extractvalue, {dst, type, val, idx, idxs=[]}). +-type llvm_extractvalue() :: #llvm_extractvalue{}. + +-record(llvm_insertvalue, {dst, val_type, val, elem_type, elem, idx, idxs=[]}). +-type llvm_insertvalue() :: #llvm_insertvalue{}. + +%% Memory Access and Addressing Operations +-record(llvm_alloca, {dst, type, num=[], align=[]}). +-type llvm_alloca() :: #llvm_alloca{}. + +-record(llvm_load, {dst, p_type, pointer, alignment=[], nontemporal=[], + volatile=false}). +-type llvm_load() :: #llvm_load{}. + +-record(llvm_store, {type, value, p_type, pointer, alignment=[], + nontemporal=[], volatile=false}). +-type llvm_store() :: #llvm_store{}. + +-record(llvm_getelementptr, {dst, p_type, value, typed_idxs, inbounds}). +-type llvm_getelementptr() :: #llvm_getelementptr{}. + +%% Conversion Operations +-record(llvm_conversion, {dst, op, src_type, src, dst_type}). +-type llvm_conversion() :: #llvm_conversion{}. + +-record(llvm_sitofp, {dst, src_type, src, dst_type}). +-type llvm_sitofp() :: #llvm_sitofp{}. + +-record(llvm_ptrtoint, {dst, src_type, src, dst_type}). +-type llvm_ptrtoint() :: #llvm_ptrtoint{}. + +-record(llvm_inttoptr, {dst, src_type, src, dst_type}). +-type llvm_inttoptr() :: #llvm_inttoptr{}. + +%% Other Operations +-record(llvm_icmp, {dst, 'cond', type, src1, src2}). +-type llvm_icmp() :: #llvm_icmp{}. + +-record(llvm_fcmp, {dst, 'cond', type, src1, src2}). +-type llvm_fcmp() :: #llvm_fcmp{}. + +-record(llvm_phi, {dst, type, value_label_list}). +-type llvm_phi() :: #llvm_phi{}. + +-record(llvm_select, {dst, 'cond', typ1, val1, typ2, val2}). +-type llvm_select() :: #llvm_select{}. + +-record(llvm_call, {dst=[], is_tail = false, cconv = [], ret_attrs = [], type, + fnptrval, arglist = [], fn_attrs = []}). +-type llvm_call() :: #llvm_call{}. + +-record(llvm_fun_def, {linkage=[], visibility=[], cconv=[], ret_attrs=[], + type, 'name', arglist=[], fn_attrs=[], align=[], body=[]}). +-type llvm_fun_def() :: #llvm_fun_def{}. + +-record(llvm_fun_decl, {linkage=[], visibility=[], cconv=[], ret_attrs=[], + type, 'name', arglist=[], align=[]}). +-type llvm_fun_decl() :: #llvm_fun_decl{}. + +-record(llvm_landingpad, {}). +-type llvm_landingpad() :: #llvm_landingpad{}. + +-record(llvm_comment, {text}). +-type llvm_comment() :: #llvm_comment{}. + +-record(llvm_label, {label}). +-type llvm_label() :: #llvm_label{}. + +-record(llvm_const_decl, {dst, decl_type, type, value}). +-type llvm_const_decl() :: #llvm_const_decl{}. + +-record(llvm_asm, {instruction}). +-type llvm_asm() :: #llvm_asm{}. + +-record(llvm_adj_stack, {offset, 'register', type}). +-type llvm_adj_stack() :: #llvm_adj_stack{}. + +-record(llvm_meta, {id :: string(), + operands :: [string() | integer() | llvm_meta()]}). +-type llvm_meta() :: #llvm_meta{}. + +%% A type for any LLVM instruction +-type llvm_instr() :: llvm_ret() | llvm_br() | llvm_br_cond() + | llvm_indirectbr() | llvm_switch() | llvm_invoke() + | llvm_operation() | llvm_extractvalue() + | llvm_insertvalue() | llvm_alloca() | llvm_load() + | llvm_store() | llvm_getelementptr() | llvm_conversion() + | llvm_sitofp() | llvm_ptrtoint() | llvm_inttoptr() + | llvm_icmp() | llvm_fcmp() | llvm_phi() | llvm_select() + | llvm_call() | llvm_fun_def() | llvm_fun_decl() + | llvm_landingpad() | llvm_comment() | llvm_label() + | llvm_const_decl() | llvm_asm() | llvm_adj_stack() + | llvm_meta(). + +%% Types +-record(llvm_void, {}). +%-type llvm_void() :: #llvm_void{}. + +-record(llvm_label_type, {}). +%-type llvm_label_type() :: #llvm_label_type{}. + +-record(llvm_int, {width}). +%-type llvm_int() :: #llvm_int{}. + +-record(llvm_float, {}). +%-type llvm_float() :: #llvm_float{}. + +-record(llvm_double, {}). +%-type llvm_double() :: #llvm_double{}. + +-record(llvm_fp80, {}). +%-type llvm_fp80() :: #llvm_fp80{}. + +-record(llvm_fp128, {}). +%-type llvm_fp128() :: #llvm_fp128{}. + +-record(llvm_ppc_fp128, {}). +%-type llvm_ppc_fp128() :: #llvm_ppc_fp128{}. + +-record(llvm_pointer, {type}). +%-type llvm_pointer() :: #llvm_pointer{}. + +-record(llvm_vector, {'size', type}). +%-type llvm_vector() :: #llvm_vector{}. + +-record(llvm_struct, {type_list}). +%-type llvm_struct() :: #llvm_struct{}. + +-record(llvm_array, {'size', type}). +%-type llvm_array() :: #llvm_array{}. + +-record(llvm_fun, {ret_type, arg_type_list}). +%-type llvm_fun() :: #llvm_fun{}. + +%%----------------------------------------------------------------------------- +%% Accessor Functions +%%----------------------------------------------------------------------------- + +%% ret +mk_ret(Ret_list) -> #llvm_ret{ret_list=Ret_list}. +ret_ret_list(#llvm_ret{ret_list=Ret_list}) -> Ret_list. + +%% br +mk_br(Dst) -> #llvm_br{dst=Dst}. +br_dst(#llvm_br{dst=Dst}) -> Dst. + +%% br_cond +mk_br_cond(Cond, True_label, False_label) -> + #llvm_br_cond{'cond'=Cond, true_label=True_label, false_label=False_label}. +mk_br_cond(Cond, True_label, False_label, Metadata) -> + #llvm_br_cond{'cond'=Cond, true_label=True_label, false_label=False_label, + meta=Metadata}. +br_cond_cond(#llvm_br_cond{'cond'=Cond}) -> Cond. +br_cond_true_label(#llvm_br_cond{true_label=True_label}) -> True_label. +br_cond_false_label(#llvm_br_cond{false_label=False_label}) -> + False_label. +br_cond_meta(#llvm_br_cond{meta=Metadata}) -> Metadata. + +%% indirectbr +mk_indirectbr(Type, Address, Label_list) -> #llvm_indirectbr{type=Type, address=Address, label_list=Label_list}. +indirectbr_type(#llvm_indirectbr{type=Type}) -> Type. +indirectbr_address(#llvm_indirectbr{address=Address}) -> Address. +indirectbr_label_list(#llvm_indirectbr{label_list=Label_list}) -> Label_list. + +%% invoke +mk_invoke(Dst, Cconv, Ret_attrs, Type, Fnptrval, Arglist, Fn_attrs, To_label, Unwind_label) -> + #llvm_invoke{dst=Dst, cconv=Cconv, ret_attrs=Ret_attrs, type=Type, + fnptrval=Fnptrval, arglist=Arglist, fn_attrs=Fn_attrs, to_label=To_label, + unwind_label=Unwind_label}. +invoke_dst(#llvm_invoke{dst=Dst}) -> Dst. +invoke_cconv(#llvm_invoke{cconv=Cconv}) -> Cconv. +invoke_ret_attrs(#llvm_invoke{ret_attrs=Ret_attrs}) -> Ret_attrs. +invoke_type(#llvm_invoke{type=Type}) -> Type. +invoke_fnptrval(#llvm_invoke{fnptrval=Fnptrval}) -> Fnptrval. +invoke_arglist(#llvm_invoke{arglist=Arglist}) -> Arglist. +invoke_fn_attrs(#llvm_invoke{fn_attrs=Fn_attrs}) -> Fn_attrs. +invoke_to_label(#llvm_invoke{to_label=To_label}) -> To_label. +invoke_unwind_label(#llvm_invoke{unwind_label=Unwind_label}) -> Unwind_label. + +%% switch +mk_switch(Type, Value, Default_label, Value_label_list) -> + #llvm_switch{type=Type, value=Value, default_label=Default_label, + value_label_list=Value_label_list}. +switch_type(#llvm_switch{type=Type}) -> Type. +switch_value(#llvm_switch{value=Value}) -> Value. +switch_default_label(#llvm_switch{default_label=Default_label}) -> + Default_label. +switch_value_label_list(#llvm_switch{value_label_list=Value_label_list}) -> + Value_label_list. + +%% operation +mk_operation(Dst, Op, Type, Src1, Src2, Options) -> + #llvm_operation{dst=Dst, op=Op, type=Type, src1=Src1, src2=Src2, + options=Options}. +operation_dst(#llvm_operation{dst=Dst}) -> Dst. +operation_op(#llvm_operation{op=Op}) -> Op. +operation_type(#llvm_operation{type=Type}) -> Type. +operation_src1(#llvm_operation{src1=Src1}) -> Src1. +operation_src2(#llvm_operation{src2=Src2}) -> Src2. +operation_options(#llvm_operation{options=Options}) -> Options. + +%% extractvalue +mk_extractvalue(Dst, Type, Val, Idx, Idxs) -> + #llvm_extractvalue{dst=Dst,type=Type,val=Val,idx=Idx,idxs=Idxs}. +extractvalue_dst(#llvm_extractvalue{dst=Dst}) -> Dst. +extractvalue_type(#llvm_extractvalue{type=Type}) -> Type. +extractvalue_val(#llvm_extractvalue{val=Val}) -> Val. +extractvalue_idx(#llvm_extractvalue{idx=Idx}) -> Idx. +extractvalue_idxs(#llvm_extractvalue{idxs=Idxs}) -> Idxs. + +%% insertvalue +mk_insertvalue(Dst, Val_type, Val, Elem_type, Elem, Idx, Idxs) -> + #llvm_insertvalue{dst=Dst, val_type=Val_type, val=Val, elem_type=Elem_type, + elem=Elem, idx=Idx, idxs=Idxs}. +insertvalue_dst(#llvm_insertvalue{dst=Dst}) -> Dst. +insertvalue_val_type(#llvm_insertvalue{val_type=Val_type}) -> Val_type. +insertvalue_val(#llvm_insertvalue{val=Val}) -> Val. +insertvalue_elem_type(#llvm_insertvalue{elem_type=Elem_type}) -> Elem_type. +insertvalue_elem(#llvm_insertvalue{elem=Elem}) -> Elem. +insertvalue_idx(#llvm_insertvalue{idx=Idx}) -> Idx. +insertvalue_idxs(#llvm_insertvalue{idxs=Idxs}) -> Idxs. + +%% alloca +mk_alloca(Dst, Type, Num, Align) -> + #llvm_alloca{dst=Dst, type=Type, num=Num, align=Align}. +alloca_dst(#llvm_alloca{dst=Dst}) -> Dst. +alloca_type(#llvm_alloca{type=Type}) -> Type. +alloca_num(#llvm_alloca{num=Num}) -> Num. +alloca_align(#llvm_alloca{align=Align}) -> Align. + +%% load +mk_load(Dst, Type, Pointer, Alignment, Nontemporal, Volatile) -> + #llvm_load{dst=Dst, p_type=Type, pointer=Pointer, alignment=Alignment, + nontemporal=Nontemporal, volatile=Volatile}. +load_dst(#llvm_load{dst=Dst}) -> Dst. +load_p_type(#llvm_load{p_type=Type}) -> Type. +load_pointer(#llvm_load{pointer=Pointer}) -> Pointer. +load_alignment(#llvm_load{alignment=Alignment}) -> Alignment. +load_nontemporal(#llvm_load{nontemporal=Nontemporal}) -> Nontemporal. +load_volatile(#llvm_load{volatile=Volatile}) -> Volatile. + +%% store +mk_store(Type, Value, P_Type, Pointer, Alignment, Nontemporal, Volatile) -> + #llvm_store{type=Type, value=Value, p_type=P_Type, pointer=Pointer, alignment=Alignment, + nontemporal=Nontemporal, volatile=Volatile}. +store_type(#llvm_store{type=Type}) -> Type. +store_value(#llvm_store{value=Value}) -> Value. +store_p_type(#llvm_store{p_type=P_Type}) -> P_Type. +store_pointer(#llvm_store{pointer=Pointer}) -> Pointer. +store_alignment(#llvm_store{alignment=Alignment}) -> Alignment. +store_nontemporal(#llvm_store{nontemporal=Nontemporal}) -> Nontemporal. +store_volatile(#llvm_store{volatile=Volatile}) -> Volatile. + +%% getelementptr +mk_getelementptr(Dst, P_Type, Value, Typed_Idxs, Inbounds) -> + #llvm_getelementptr{dst=Dst,p_type=P_Type, value=Value, + typed_idxs=Typed_Idxs, inbounds=Inbounds}. +getelementptr_dst(#llvm_getelementptr{dst=Dst}) -> Dst. +getelementptr_p_type(#llvm_getelementptr{p_type=P_Type}) -> P_Type. +getelementptr_value(#llvm_getelementptr{value=Value}) -> Value. +getelementptr_typed_idxs(#llvm_getelementptr{typed_idxs=Typed_Idxs}) -> Typed_Idxs. +getelementptr_inbounds(#llvm_getelementptr{inbounds=Inbounds}) -> Inbounds. + +%% conversion +mk_conversion(Dst, Op, Src_type, Src, Dst_type) -> + #llvm_conversion{dst=Dst, op=Op, src_type=Src_type, src=Src, dst_type=Dst_type}. +conversion_dst(#llvm_conversion{dst=Dst}) -> Dst. +conversion_op(#llvm_conversion{op=Op}) -> Op. +conversion_src_type(#llvm_conversion{src_type=Src_type}) -> Src_type. +conversion_src(#llvm_conversion{src=Src}) -> Src. +conversion_dst_type(#llvm_conversion{dst_type=Dst_type}) -> Dst_type. + +%% sitofp +mk_sitofp(Dst, Src_type, Src, Dst_type) -> + #llvm_sitofp{dst=Dst, src_type=Src_type, src=Src, dst_type=Dst_type}. +sitofp_dst(#llvm_sitofp{dst=Dst}) -> Dst. +sitofp_src_type(#llvm_sitofp{src_type=Src_type}) -> Src_type. +sitofp_src(#llvm_sitofp{src=Src}) -> Src. +sitofp_dst_type(#llvm_sitofp{dst_type=Dst_type}) -> Dst_type. + +%% ptrtoint +mk_ptrtoint(Dst, Src_Type, Src, Dst_Type) -> + #llvm_ptrtoint{dst=Dst, src_type=Src_Type, src=Src, dst_type=Dst_Type}. +ptrtoint_dst(#llvm_ptrtoint{dst=Dst}) -> Dst. +ptrtoint_src_type(#llvm_ptrtoint{src_type=Src_Type}) -> Src_Type. +ptrtoint_src(#llvm_ptrtoint{src=Src}) -> Src. +ptrtoint_dst_type(#llvm_ptrtoint{dst_type=Dst_Type}) -> Dst_Type . + +%% inttoptr +mk_inttoptr(Dst, Src_Type, Src, Dst_Type) -> + #llvm_inttoptr{dst=Dst, src_type=Src_Type, src=Src, dst_type=Dst_Type}. +inttoptr_dst(#llvm_inttoptr{dst=Dst}) -> Dst. +inttoptr_src_type(#llvm_inttoptr{src_type=Src_Type}) -> Src_Type. +inttoptr_src(#llvm_inttoptr{src=Src}) -> Src. +inttoptr_dst_type(#llvm_inttoptr{dst_type=Dst_Type}) -> Dst_Type . + +%% icmp +mk_icmp(Dst, Cond, Type, Src1, Src2) -> + #llvm_icmp{dst=Dst,'cond'=Cond,type=Type,src1=Src1,src2=Src2}. +icmp_dst(#llvm_icmp{dst=Dst}) -> Dst. +icmp_cond(#llvm_icmp{'cond'=Cond}) -> Cond. +icmp_type(#llvm_icmp{type=Type}) -> Type. +icmp_src1(#llvm_icmp{src1=Src1}) -> Src1. +icmp_src2(#llvm_icmp{src2=Src2}) -> Src2. + +%% fcmp +mk_fcmp(Dst, Cond, Type, Src1, Src2) -> + #llvm_fcmp{dst=Dst,'cond'=Cond,type=Type,src1=Src1,src2=Src2}. +fcmp_dst(#llvm_fcmp{dst=Dst}) -> Dst. +fcmp_cond(#llvm_fcmp{'cond'=Cond}) -> Cond. +fcmp_type(#llvm_fcmp{type=Type}) -> Type. +fcmp_src1(#llvm_fcmp{src1=Src1}) -> Src1. +fcmp_src2(#llvm_fcmp{src2=Src2}) -> Src2. + +%% phi +mk_phi(Dst, Type, Value_label_list) -> + #llvm_phi{dst=Dst, type=Type,value_label_list=Value_label_list}. +phi_dst(#llvm_phi{dst=Dst}) -> Dst. +phi_type(#llvm_phi{type=Type}) -> Type. +phi_value_label_list(#llvm_phi{value_label_list=Value_label_list}) -> + Value_label_list. + +%% select +mk_select(Dst, Cond, Typ1, Val1, Typ2, Val2) -> + #llvm_select{dst=Dst, 'cond'=Cond, typ1=Typ1, val1=Val1, typ2=Typ2, val2=Val2}. +select_dst(#llvm_select{dst=Dst}) -> Dst. +select_cond(#llvm_select{'cond'=Cond}) -> Cond. +select_typ1(#llvm_select{typ1=Typ1}) -> Typ1. +select_val1(#llvm_select{val1=Val1}) -> Val1. +select_typ2(#llvm_select{typ2=Typ2}) -> Typ2. +select_val2(#llvm_select{val2=Val2}) -> Val2. + +%% call +mk_call(Dst, Is_tail, Cconv, Ret_attrs, Type, Fnptrval, Arglist, Fn_attrs) -> + #llvm_call{dst=Dst, is_tail=Is_tail, cconv=Cconv, ret_attrs=Ret_attrs, + type=Type, fnptrval=Fnptrval, arglist=Arglist, fn_attrs=Fn_attrs}. +call_dst(#llvm_call{dst=Dst}) -> Dst. +call_is_tail(#llvm_call{is_tail=Is_tail}) -> Is_tail. +call_cconv(#llvm_call{cconv=Cconv}) -> Cconv. +call_ret_attrs(#llvm_call{ret_attrs=Ret_attrs}) -> Ret_attrs. +call_type(#llvm_call{type=Type}) -> Type. +call_fnptrval(#llvm_call{fnptrval=Fnptrval}) -> Fnptrval. +call_arglist(#llvm_call{arglist=Arglist}) -> Arglist. +call_fn_attrs(#llvm_call{fn_attrs=Fn_attrs}) -> Fn_attrs. + +%% fun_def +mk_fun_def(Linkage, Visibility, Cconv, Ret_attrs, Type, Name, Arglist, + Fn_attrs, Align, Body) -> + #llvm_fun_def{ + linkage=Linkage, + visibility=Visibility, + cconv=Cconv, + ret_attrs=Ret_attrs, + type=Type, + 'name'=Name, + arglist=Arglist, + fn_attrs=Fn_attrs, + align=Align, + body=Body + }. + +fun_def_linkage(#llvm_fun_def{linkage=Linkage}) -> Linkage. +fun_def_visibility(#llvm_fun_def{visibility=Visibility}) -> Visibility. +fun_def_cconv(#llvm_fun_def{cconv=Cconv}) -> Cconv . +fun_def_ret_attrs(#llvm_fun_def{ret_attrs=Ret_attrs}) -> Ret_attrs. +fun_def_type(#llvm_fun_def{type=Type}) -> Type. +fun_def_name(#llvm_fun_def{'name'=Name}) -> Name. +fun_def_arglist(#llvm_fun_def{arglist=Arglist}) -> Arglist. +fun_def_fn_attrs(#llvm_fun_def{fn_attrs=Fn_attrs}) -> Fn_attrs. +fun_def_align(#llvm_fun_def{align=Align}) -> Align. +fun_def_body(#llvm_fun_def{body=Body}) -> Body. + +%% fun_decl +mk_fun_decl(Linkage, Visibility, Cconv, Ret_attrs, Type, Name, Arglist, Align)-> + #llvm_fun_decl{ + linkage=Linkage, + visibility=Visibility, + cconv=Cconv, + ret_attrs=Ret_attrs, + type=Type, + 'name'=Name, + arglist=Arglist, + align=Align + }. + +fun_decl_linkage(#llvm_fun_decl{linkage=Linkage}) -> Linkage. +fun_decl_visibility(#llvm_fun_decl{visibility=Visibility}) -> Visibility. +fun_decl_cconv(#llvm_fun_decl{cconv=Cconv}) -> Cconv . +fun_decl_ret_attrs(#llvm_fun_decl{ret_attrs=Ret_attrs}) -> Ret_attrs. +fun_decl_type(#llvm_fun_decl{type=Type}) -> Type. +fun_decl_name(#llvm_fun_decl{'name'=Name}) -> Name. +fun_decl_arglist(#llvm_fun_decl{arglist=Arglist}) -> Arglist. +fun_decl_align(#llvm_fun_decl{align=Align}) -> Align. + +%% landingpad +mk_landingpad() -> #llvm_landingpad{}. + +%% comment +mk_comment(Text) -> #llvm_comment{text=Text}. +comment_text(#llvm_comment{text=Text}) -> Text. + +%% label +mk_label(Label) -> #llvm_label{label=Label}. +label_label(#llvm_label{label=Label}) -> Label. + +-spec is_label(llvm_instr()) -> boolean(). +is_label(#llvm_label{}) -> true; +is_label(#llvm_ret{}) -> false; +is_label(#llvm_br{}) -> false; +is_label(#llvm_br_cond{}) -> false; +is_label(#llvm_indirectbr{}) -> false; +is_label(#llvm_switch{}) -> false; +is_label(#llvm_invoke{}) -> false; +is_label(#llvm_operation{}) -> false; +is_label(#llvm_extractvalue{}) -> false; +is_label(#llvm_insertvalue{}) -> false; +is_label(#llvm_alloca{}) -> false; +is_label(#llvm_load{}) -> false; +is_label(#llvm_store{}) -> false; +is_label(#llvm_getelementptr{}) -> false; +is_label(#llvm_conversion{}) -> false; +is_label(#llvm_sitofp{}) -> false; +is_label(#llvm_ptrtoint{}) -> false; +is_label(#llvm_inttoptr{}) -> false; +is_label(#llvm_icmp{}) -> false; +is_label(#llvm_fcmp{}) -> false; +is_label(#llvm_phi{}) -> false; +is_label(#llvm_select{}) -> false; +is_label(#llvm_call{}) -> false; +is_label(#llvm_fun_def{}) -> false; +is_label(#llvm_fun_decl{}) -> false; +is_label(#llvm_landingpad{}) -> false; +is_label(#llvm_comment{}) -> false; +is_label(#llvm_const_decl{}) -> false; +is_label(#llvm_asm{}) -> false; +is_label(#llvm_adj_stack{}) -> false; +is_label(#llvm_meta{}) -> false. + +%% const_decl +mk_const_decl(Dst, Decl_type, Type, Value) -> + #llvm_const_decl{dst=Dst, decl_type=Decl_type, type=Type, value=Value}. +const_decl_dst(#llvm_const_decl{dst=Dst}) -> Dst. +const_decl_decl_type(#llvm_const_decl{decl_type=Decl_type}) -> Decl_type. +const_decl_type(#llvm_const_decl{type=Type}) -> Type. +const_decl_value(#llvm_const_decl{value=Value}) -> Value. + +%% asm +mk_asm(Instruction) -> #llvm_asm{instruction=Instruction}. +asm_instruction(#llvm_asm{instruction=Instruction}) -> Instruction. + +%% adj_stack +mk_adj_stack(Offset, Register, Type) -> + #llvm_adj_stack{offset=Offset, 'register'=Register, type=Type}. +adj_stack_offset(#llvm_adj_stack{offset=Offset}) -> Offset. +adj_stack_register(#llvm_adj_stack{'register'=Register}) -> Register. +adj_stack_type(#llvm_adj_stack{type=Type}) -> Type. + +%% meta-data +mk_meta(Id, Operands) -> + #llvm_meta{id=Id, operands=Operands}. +meta_id(#llvm_meta{id=Id}) -> Id. +meta_operands(#llvm_meta{operands=Operands}) -> Operands. + +%% types +mk_void() -> #llvm_void{}. + +mk_label_type() -> #llvm_label_type{}. + +mk_int(Width) -> #llvm_int{width=Width}. +int_width(#llvm_int{width=Width}) -> Width. + +mk_double() -> #llvm_double{}. + +mk_pointer(Type) -> #llvm_pointer{type=Type}. +pointer_type(#llvm_pointer{type=Type}) -> Type. + +mk_array(Size, Type) -> #llvm_array{'size'=Size, type=Type}. +array_size(#llvm_array{'size'=Size}) -> Size. +array_type(#llvm_array{type=Type}) -> Type. + +mk_vector(Size, Type) -> #llvm_vector{'size'=Size, type=Type}. +vector_size(#llvm_vector{'size'=Size}) -> Size. +vector_type(#llvm_vector{type=Type}) -> Type. + +mk_struct(Type_list) -> #llvm_struct{type_list=Type_list}. +struct_type_list(#llvm_struct{type_list=Type_list}) -> Type_list. + +mk_fun(Ret_type, Arg_type_list) -> + #llvm_fun{ret_type=Ret_type, arg_type_list=Arg_type_list}. +function_ret_type(#llvm_fun{ret_type=Ret_type}) -> Ret_type. +function_arg_type_list(#llvm_fun{arg_type_list=Arg_type_list}) -> + Arg_type_list. + +%%---------------------------------------------------------------------------- +%% Pretty-printer Functions +%%---------------------------------------------------------------------------- + +-type llvm_version() :: {Major :: integer(), Minor :: integer()}. + +%% @doc Pretty-print a list of LLVM instructions to a Device, using syntax +%% compatible with LLVM v. Major.Minor +-spec pp_ins_list(file:io_device(), llvm_version(), [llvm_instr()]) -> ok. +pp_ins_list(_Dev, _Ver, []) -> ok; +pp_ins_list(Dev, Ver={_,_}, [I|Is]) -> + pp_ins(Dev, Ver, I), + pp_ins_list(Dev, Ver, Is). + +pp_ins(Dev, Ver, I) -> + case indent(I) of + true -> write(Dev, " "); + false -> ok + end, + case I of + #llvm_ret{} -> + write(Dev, "ret "), + case ret_ret_list(I) of + [] -> write(Dev, "void"); + List -> pp_args(Dev, List) + end, + write(Dev, "\n"); + #llvm_br{} -> + write(Dev, ["br label ", br_dst(I), "\n"]); + #llvm_switch{} -> + write(Dev, "switch "), + pp_type(Dev, switch_type(I)), + write(Dev, [" ", switch_value(I), ", label ", switch_default_label(I), + " \n [\n"]), + pp_switch_value_label_list(Dev, switch_type(I), + switch_value_label_list(I)), + write(Dev, " ]\n"); + #llvm_invoke{} -> + write(Dev, [invoke_dst(I), " = invoke ", invoke_cconv(I), " "]), + pp_options(Dev, invoke_ret_attrs(I)), + pp_type(Dev, invoke_type(I)), + write(Dev, [" ", invoke_fnptrval(I), "("]), + pp_args(Dev, invoke_arglist(I)), + write(Dev, ") "), + pp_options(Dev, invoke_fn_attrs(I)), + write(Dev, [" to label ", invoke_to_label(I)," unwind label ", + invoke_unwind_label(I), " \n"]); + #llvm_br_cond{} -> + write(Dev, ["br i1 ", br_cond_cond(I), ", label ", br_cond_true_label(I), + ", label ", br_cond_false_label(I)]), + case br_cond_meta(I) of + [] -> ok; + Metadata -> + write(Dev, [", !prof !", Metadata]) + end, + write(Dev, "\n"); + #llvm_indirectbr{} -> + write(Dev, "indirectbr "), + pp_type(Dev, indirectbr_type(I)), + write(Dev, [" ", indirectbr_address(I), ", [ "]), + pp_args(Dev, indirectbr_label_list(I)), + write(Dev, " ]\n"); + #llvm_operation{} -> + write(Dev, [operation_dst(I), " = ", atom_to_list(operation_op(I)), " "]), + case op_has_options(operation_op(I)) of + true -> pp_options(Dev, operation_options(I)); + false -> ok + end, + pp_type(Dev, operation_type(I)), + write(Dev, [" ", operation_src1(I), ", ", operation_src2(I), "\n"]); + #llvm_extractvalue{} -> + write(Dev, [extractvalue_dst(I), " = extractvalue "]), + pp_type(Dev, extractvalue_type(I)), + %% TODO Print idxs + write(Dev, [" ", extractvalue_val(I), ", ", extractvalue_idx(I), "\n"]); + #llvm_insertvalue{} -> + write(Dev, [insertvalue_dst(I), " = insertvalue "]), + pp_type(Dev, insertvalue_val_type(I)), + write(Dev, [" ", insertvalue_val(I), ", "]), + pp_type(Dev, insertvalue_elem_type(I)), + %%TODO Print idxs + write(Dev, [" ", insertvalue_elem(I), ", ", insertvalue_idx(I), "\n"]); + #llvm_alloca{} -> + write(Dev, [alloca_dst(I), " = alloca "]), + pp_type(Dev, alloca_type(I)), + case alloca_num(I) of + [] -> ok; + Num -> + write(Dev, ", "), + pp_type(Dev, alloca_type(I)), + write(Dev, [" ", Num, " "]) + end, + case alloca_align(I) of + [] -> ok; + Align -> write(Dev, [",align ", Align]) + end, + write(Dev, "\n"); + #llvm_load{} -> + write(Dev, [load_dst(I), " = "]), + write(Dev, "load "), + case load_volatile(I) of + true -> write(Dev, "volatile "); + false -> ok + end, + pp_dereference_type(Dev, Ver, load_p_type(I)), + write(Dev, [" ", load_pointer(I), " "]), + case load_alignment(I) of + [] -> ok; + Al -> write(Dev, [", align ", Al, " "]) + end, + case load_nontemporal(I) of + [] -> ok; + In -> write(Dev, [", !nontemporal !", In]) + end, + write(Dev, "\n"); + #llvm_store{} -> + write(Dev, "store "), + case store_volatile(I) of + true -> write(Dev, "volatile "); + false -> ok + end, + pp_type(Dev, store_type(I)), + write(Dev, [" ", store_value(I), ", "]), + pp_type(Dev, store_p_type(I)), + write(Dev, [" ", store_pointer(I), " "]), + case store_alignment(I) of + [] -> ok; + Al -> write(Dev, [", align ", Al, " "]) + end, + case store_nontemporal(I) of + [] -> ok; + In -> write(Dev, [", !nontemporal !", In]) + end, + write(Dev, "\n"); + #llvm_getelementptr{} -> + write(Dev, [getelementptr_dst(I), " = getelementptr "]), + case getelementptr_inbounds(I) of + true -> write(Dev, "inbounds "); + false -> ok + end, + pp_dereference_type(Dev, Ver, getelementptr_p_type(I)), + write(Dev, [" ", getelementptr_value(I)]), + pp_typed_idxs(Dev, getelementptr_typed_idxs(I)), + write(Dev, "\n"); + #llvm_conversion{} -> + write(Dev, [conversion_dst(I), " = ", atom_to_list(conversion_op(I)), " "]), + pp_type(Dev, conversion_src_type(I)), + write(Dev, [" ", conversion_src(I), " to "]), + pp_type(Dev, conversion_dst_type(I)), + write(Dev, "\n"); + #llvm_icmp{} -> + write(Dev, [icmp_dst(I), " = icmp ", atom_to_list(icmp_cond(I)), " "]), + pp_type(Dev, icmp_type(I)), + write(Dev, [" ", icmp_src1(I), ", ", icmp_src2(I), "\n"]); + #llvm_fcmp{} -> + write(Dev, [fcmp_dst(I), " = fcmp ", atom_to_list(fcmp_cond(I)), " "]), + pp_type(Dev, fcmp_type(I)), + write(Dev, [" ", fcmp_src1(I), ", ", fcmp_src2(I), "\n"]); + #llvm_phi{} -> + write(Dev, [phi_dst(I), " = phi "]), + pp_type(Dev, phi_type(I)), + pp_phi_value_labels(Dev, phi_value_label_list(I)), + write(Dev, "\n"); + #llvm_select{} -> + write(Dev, [select_dst(I), " = select i1 ", select_cond(I), ", "]), + pp_type(Dev, select_typ1(I)), + write(Dev, [" ", select_val1(I), ", "]), + pp_type(Dev, select_typ2(I)), + write(Dev, [" ", select_val2(I), "\n"]); + #llvm_call{} -> + case call_dst(I) of + [] -> ok; + Dst -> write(Dev, [Dst, " = "]) + end, + case call_is_tail(I) of + true -> write(Dev, "tail "); + false -> ok + end, + write(Dev, ["call ", call_cconv(I), " "]), + pp_options(Dev, call_ret_attrs(I)), + pp_type(Dev, call_type(I)), + write(Dev, [" ", call_fnptrval(I), "("]), + pp_args(Dev, call_arglist(I)), + write(Dev, ") "), + pp_options(Dev, call_fn_attrs(I)), + write(Dev, "\n"); + #llvm_fun_def{} -> + write(Dev, "define "), + pp_options(Dev, fun_def_linkage(I)), + pp_options(Dev, fun_def_visibility(I)), + case fun_def_cconv(I) of + [] -> ok; + Cc -> write(Dev, [Cc, " "]) + end, + pp_options(Dev, fun_def_ret_attrs(I)), + write(Dev, " "), + pp_type(Dev, fun_def_type(I)), + write(Dev, [" @", fun_def_name(I), "("]), + pp_args(Dev, fun_def_arglist(I)), + write(Dev, ") "), + pp_options(Dev, fun_def_fn_attrs(I)), + case Ver >= {3,7} of false -> ok; true -> + write(Dev, "personality i32 (i32, i64, i8*,i8*)* " + "@__gcc_personality_v0 ") + end, + case fun_def_align(I) of + [] -> ok; + N -> write(Dev, ["align ", N]) + end, + write(Dev, "{\n"), + pp_ins_list(Dev, Ver, fun_def_body(I)), + write(Dev, "}\n"); + #llvm_fun_decl{} -> + write(Dev, "declare "), + pp_options(Dev, fun_decl_linkage(I)), + pp_options(Dev, fun_decl_visibility(I)), + case fun_decl_cconv(I) of + [] -> ok; + Cc -> write(Dev, [Cc, " "]) + end, + pp_options(Dev, fun_decl_ret_attrs(I)), + pp_type(Dev, fun_decl_type(I)), + write(Dev, [" ", fun_decl_name(I), "("]), + pp_type_list(Dev, fun_decl_arglist(I)), + write(Dev, ") "), + case fun_decl_align(I) of + [] -> ok; + N -> write(Dev, ["align ", N]) + end, + write(Dev, "\n"); + #llvm_comment{} -> + write(Dev, ["; ", atom_to_list(comment_text(I)), "\n"]); + #llvm_label{} -> + write(Dev, [label_label(I), ":\n"]); + #llvm_const_decl{} -> + write(Dev, [const_decl_dst(I), " = ", const_decl_decl_type(I), " "]), + pp_type(Dev, const_decl_type(I)), + write(Dev, [" ", const_decl_value(I), "\n"]); + #llvm_landingpad{} -> + write(Dev, "landingpad { i8*, i32 } "), + case Ver < {3,7} of false -> ok; true -> + write(Dev, "personality i32 (i32, i64, i8*,i8*)* " + "@__gcc_personality_v0 ") + end, + write(Dev, "cleanup\n"); + #llvm_asm{} -> + write(Dev, [asm_instruction(I), "\n"]); + #llvm_adj_stack{} -> + write(Dev, ["call void asm sideeffect \"sub $0, ", + adj_stack_register(I), "\", \"r\"("]), + pp_type(Dev, adj_stack_type(I)), + write(Dev, [" ", adj_stack_offset(I),")\n"]); + #llvm_meta{} -> + write(Dev, ["!", meta_id(I), " = "]), + Named = case string:to_integer(meta_id(I)) of + {_, ""} -> false; + _ -> true + end, + case Ver < {3,6} andalso not Named of + true -> write(Dev, "metadata !{metadata "); + false -> write(Dev, "!{ ") + end, + write(Dev, string:join([if is_list(Op) -> ["!\"", Op, "\""]; + is_integer(Op) -> ["i32 ", integer_to_list(Op)]; + is_record(Op, llvm_meta) -> + ["!", meta_id(Op)] + end || Op <- meta_operands(I)], ", ")), + write(Dev, " }\n"); + Other -> + exit({?MODULE, pp_ins, {"Unknown LLVM instruction", Other}}) + end. + +%% @doc Print the type of a dereference in an LLVM instruction using syntax +%% parsable by the specified LLVM version. +pp_dereference_type(Dev, Ver, Type) -> + case Ver >= {3,7} of + false -> ok; + true -> + pp_type(Dev, pointer_type(Type)), + write(Dev, ", ") + end, + pp_type(Dev, Type). + +%% @doc Pretty-print a list of types +pp_type_list(_Dev, []) -> ok; +pp_type_list(Dev, [T]) -> + pp_type(Dev, T); +pp_type_list(Dev, [T|Ts]) -> + pp_type(Dev, T), + write(Dev, ", "), + pp_type_list(Dev, Ts). + +pp_type(Dev, Type) -> + case Type of + #llvm_void{} -> + write(Dev, "void"); + #llvm_label_type{} -> + write(Dev, "label"); + %% Integer + #llvm_int{} -> + write(Dev, ["i", integer_to_list(int_width(Type))]); + %% Float + #llvm_float{} -> + write(Dev, "float"); + #llvm_double{} -> + write(Dev, "double"); + #llvm_fp80{} -> + write(Dev, "x86_fp80"); + #llvm_fp128{} -> + write(Dev, "fp128"); + #llvm_ppc_fp128{} -> + write(Dev, "ppc_fp128"); + %% Pointer + #llvm_pointer{} -> + pp_type(Dev, pointer_type(Type)), + write(Dev, "*"); + %% Function + #llvm_fun{} -> + pp_type(Dev, function_ret_type(Type)), + write(Dev, " ("), + pp_type_list(Dev, function_arg_type_list(Type)), + write(Dev, ")"); + %% Aggregate + #llvm_array{} -> + write(Dev, ["[", integer_to_list(array_size(Type)), " x "]), + pp_type(Dev, array_type(Type)), + write(Dev, "]"); + #llvm_struct{} -> + write(Dev, "{"), + pp_type_list(Dev, struct_type_list(Type)), + write(Dev, "}"); + #llvm_vector{} -> + write(Dev, ["{", integer_to_list(vector_size(Type)), " x "]), + pp_type(Dev, vector_type(Type)), + write(Dev, "}") + end. + +%% @doc Pretty-print a list of typed arguments +pp_args(_Dev, []) -> ok; +pp_args(Dev, [{Type, Arg} | []]) -> + pp_type(Dev, Type), + write(Dev, [" ", Arg]); +pp_args(Dev, [{Type, Arg} | Args]) -> + pp_type(Dev, Type), + write(Dev, [" ", Arg, ", "]), + pp_args(Dev, Args). + +%% @doc Pretty-print a list of options +pp_options(_Dev, []) -> ok; +pp_options(Dev, [O|Os]) -> + write(Dev, [atom_to_list(O), " "]), + pp_options(Dev, Os). + +%% @doc Pretty-print a list of phi value-labels +pp_phi_value_labels(_Dev, []) -> ok; +pp_phi_value_labels(Dev, [{Value, Label}|[]]) -> + write(Dev, ["[ ", Value, ", ", Label, " ]"]); +pp_phi_value_labels(Dev,[{Value, Label}|VL]) -> + write(Dev, ["[ ", Value, ", ", Label, " ], "]), + pp_phi_value_labels(Dev, VL). + +%% @doc Pretty-print a list of typed indexes +pp_typed_idxs(_Dev, []) -> ok; +pp_typed_idxs(Dev, [{Type, Id} | Tids]) -> + write(Dev, ", "), + pp_type(Dev, Type), + write(Dev, [" ", Id]), + pp_typed_idxs(Dev, Tids). + +%% @doc Pretty-print a switch label list +pp_switch_value_label_list(_Dev, _Type, []) -> ok; +pp_switch_value_label_list(Dev, Type, [{Value, Label} | VLs]) -> + write(Dev, " "), + pp_type(Dev, Type), + write(Dev, [" ", Value, ", label ", Label, "\n"]), + pp_switch_value_label_list(Dev, Type, VLs). + +%%---------------------------------------------------------------------------- +%% Auxiliary Functions +%%---------------------------------------------------------------------------- + +%% @doc Returns if an instruction needs to be intended +indent(I) -> + case I of + #llvm_label{} -> false; + #llvm_fun_def{} -> false; + #llvm_fun_decl{} -> false; + #llvm_const_decl{} -> false; + #llvm_meta{} -> false; + _ -> true + end. + +op_has_options(Op) -> + case Op of + 'and' -> false; + 'or' -> false; + 'xor' -> false; + _ -> true + end. + +%% @doc Abstracts actual writing to file operations +write(Dev, Msg) -> + ok = file:write(Dev, Msg). diff --git a/lib/hipe/llvm/hipe_llvm_arch.hrl b/lib/hipe/llvm/hipe_llvm_arch.hrl new file mode 100644 index 0000000000..689a5a52ea --- /dev/null +++ b/lib/hipe/llvm/hipe_llvm_arch.hrl @@ -0,0 +1,11 @@ +-ifdef(BIT32). +-define(NR_PINNED_REGS, 2). +-define(NR_ARG_REGS, 3). +-define(ARCH_REGISTERS, hipe_x86_registers). +-define(FLOAT_OFFSET, 2). +-else. +-define(NR_PINNED_REGS, 2). +-define(NR_ARG_REGS, 4). +-define(ARCH_REGISTERS, hipe_amd64_registers). +-define(FLOAT_OFFSET, 6). +-endif. diff --git a/lib/hipe/llvm/hipe_llvm_liveness.erl b/lib/hipe/llvm/hipe_llvm_liveness.erl new file mode 100644 index 0000000000..d1c90ed4c9 --- /dev/null +++ b/lib/hipe/llvm/hipe_llvm_liveness.erl @@ -0,0 +1,112 @@ +-module(hipe_llvm_liveness). + +-export([analyze/1]). + +%% @doc Find gc roots and explicitly mark when they go out of scope, based +%% on the liveness analyzis performed by the hipe_rtl_liveness:analyze/1. +analyze(RtlCfg) -> + Liveness = hipe_rtl_liveness:analyze(RtlCfg), + Roots = find_roots(RtlCfg, Liveness), + %% erlang:display(Roots), + NewRtlCfg = mark_dead_roots(RtlCfg, Liveness, Roots), + {NewRtlCfg, Roots}. + +%% @doc Determine which are the GC Roots.Possible roots are all +%% RTL variables (rtl_var). However, since safe points are function calls, we +%% consider as possible GC roots only RTL variables that are live around +%% function calls. +find_roots(Cfg, Liveness) -> + Labels = hipe_rtl_cfg:postorder(Cfg), + Roots = find_roots_bb(Labels, Cfg, Liveness, []), + lists:usort(lists:flatten(Roots)). + +find_roots_bb([], _Cfg, _Liveness, RootAcc) -> + RootAcc; +find_roots_bb([L|Ls], Cfg, Liveness, RootAcc) -> + Block = hipe_rtl_cfg:bb(Cfg, L), + BlockCode = hipe_bb:code(Block), + LiveIn = ordsets:from_list(strip(hipe_rtl_liveness:livein(Liveness, L))), + LiveOut = ordsets:from_list(strip(hipe_rtl_liveness:liveout(Liveness, L))), + Roots = do_find_roots_bb(BlockCode, L, LiveOut, LiveIn, []), + find_roots_bb(Ls, Cfg, Liveness, Roots++RootAcc). + +%% For each call inside a BB the GC roots are those RTL variables that +%% are live before and after the call. +%% --> Live Before Call: These are the RTL variables that belong to the +%% LiveIn list or are initialized inside the BB before the call +%% --> Live After Call: These are the RTL variables that belong to the +%% LiveOut list or are used after the call inside the BB (they die +%% inside the BB and so do not belong to the LiveOut list) +do_find_roots_bb([], _Label, _LiveOut, _LiveBefore, RootAcc) -> + RootAcc; +do_find_roots_bb([I|Is], L, LiveOut, LiveBefore, RootAcc) -> + case hipe_rtl:is_call(I) of + true -> + %% Used inside the BB after the call + UsedAfterCall_ = strip(lists:flatten([hipe_rtl:uses(V) || V <- Is])), + UsedAfterCall = ordsets:from_list(UsedAfterCall_), + LiveAfter = ordsets:union(UsedAfterCall, LiveOut), + %% The Actual Roots + Roots = ordsets:intersection(LiveBefore, LiveAfter), + %% The result of the instruction + Defines = ordsets:from_list(strip(hipe_rtl:defines(I))), + LiveBefore1 = ordsets:union(LiveBefore, Defines), + do_find_roots_bb(Is, L, LiveOut, LiveBefore1, [Roots|RootAcc]); + false -> + %% The result of the instruction + Defines = ordsets:from_list(strip(hipe_rtl:defines(I))), + LiveBefore1 = ordsets:union(LiveBefore, Defines), + do_find_roots_bb(Is, L, LiveOut, LiveBefore1, RootAcc) + end. + +%% @doc This function is responsible for marking when GC Roots, which can be +%% only RTL variables go out of scope (dead). This pass is needed for the LLVM +%% back end because the LLVM framework forces us to explicit mark when gc roots +%% are no longer live. +mark_dead_roots(CFG, Liveness, Roots) -> + Labels = hipe_rtl_cfg:postorder(CFG), + mark_dead_bb(Labels, CFG, Liveness, Roots). + +mark_dead_bb([], Cfg, _Liveness, _Roots) -> + Cfg; +mark_dead_bb([L|Ls], Cfg, Liveness, Roots) -> + Block = hipe_rtl_cfg:bb(Cfg, L), + BlockCode = hipe_bb:code(Block), + LiveOut = ordsets:from_list(strip(hipe_rtl_liveness:liveout(Liveness, L))), + NewBlockCode = do_mark_dead_bb(BlockCode, LiveOut, Roots, []), + %% Update the CFG + NewBB = hipe_bb:code_update(Block, NewBlockCode), + NewCFG = hipe_rtl_cfg:bb_add(Cfg, L, NewBB), + mark_dead_bb(Ls, NewCFG, Liveness, Roots). + +do_mark_dead_bb([], _LiveOut, _Roots, NewBlockCode) -> + lists:reverse(NewBlockCode); +do_mark_dead_bb([I|Is], LiveOut ,Roots, NewBlockCode) -> + Uses = ordsets:from_list(strip(hipe_rtl:uses(I))), + %% GC roots that are used in this instruction + RootsUsed = ordsets:intersection(Roots, Uses), + UsedAfter_ = strip(lists:flatten([hipe_rtl:uses(V) || V <- Is])), + UsedAfter = ordsets:from_list(UsedAfter_), + %% GC roots that are live after this instruction + LiveAfter = ordsets:union(LiveOut, UsedAfter), + %% GC roots that their last use is in this instruction + DeadRoots = ordsets:subtract(RootsUsed, LiveAfter), + %% Recreate the RTL variable from the corresponding Index + OldVars = [hipe_rtl:mk_var(V1) || V1 <- DeadRoots], + %% Mark the RTL variable as DEAD (last use) + NewVars = [kill_var(V2) || V2 <- OldVars], + %% Create a list with the substitution of the old vars with the new + %% ones which are marked with the dead keyword + Subtitution = lists:zip(OldVars, NewVars), + NewI = case Subtitution of + [] -> I; + _ -> hipe_rtl:subst_uses_llvm(Subtitution, I) + end, + do_mark_dead_bb(Is, LiveOut, Roots, [NewI|NewBlockCode]). + +%% Update the liveness of a var,in order to mark that this is the last use. +kill_var(Var) -> hipe_rtl:var_liveness_update(Var, dead). + +%% We are only interested for rtl_vars, since only rtl_vars are possible gc +%% roots. +strip(L) -> [Y || {rtl_var, Y, _} <- L]. diff --git a/lib/hipe/llvm/hipe_llvm_main.erl b/lib/hipe/llvm/hipe_llvm_main.erl new file mode 100644 index 0000000000..476d6fb49c --- /dev/null +++ b/lib/hipe/llvm/hipe_llvm_main.erl @@ -0,0 +1,525 @@ +%% -*- erlang-indent-level: 2 -*- +-module(hipe_llvm_main). + +-export([rtl_to_native/4]). + +-include("../../kernel/src/hipe_ext_format.hrl"). +-include("hipe_llvm_arch.hrl"). +-include("elf_format.hrl"). + +%% @doc Translation of RTL to a loadable object. This function takes the RTL +%% code and calls hipe_rtl_to_llvm:translate/2 to translate the RTL code to +%% LLVM code. After this, LLVM asm is printed to a file and the LLVM tool +%% chain is invoked in order to produce an object file. +rtl_to_native(MFA, RTL, Roots, Options) -> + %% Compile to LLVM and get Instruction List (along with infos) + {LLVMCode, RelocsDict0, ConstTab0} = + hipe_rtl_to_llvm:translate(RTL, Roots), + %% Fix function name to an acceptable LLVM identifier (needed for closures) + {_Module, Fun, Arity} = hipe_rtl_to_llvm:fix_mfa_name(MFA), + %% Write LLVM Assembly to intermediate file (on disk) + {ok, Dir, ObjectFile} = + compile_with_llvm(Fun, Arity, LLVMCode, Options, false), + %% + %% Extract information from object file + %% + ObjBin = open_object_file(ObjectFile), + Obj = elf_format:read(ObjBin), + %% Get labels info (for switches and jump tables) + Labels = elf_format:extract_rela(Obj, ?RODATA), + Tables = get_tables(Obj), + %% Associate Labels with Switches and Closures with stack args + {SwitchInfos, ExposedClosures} = correlate_labels(Tables, Labels), + %% SwitchInfos: [{"table_50", [Labels]}] + %% ExposedClosures: [{"table_closures", [Labels]}] + + %% Labelmap contains the offsets of the labels in the code that are + %% used for switch's jump tables + LabelMap = create_labelmap(MFA, SwitchInfos, RelocsDict0), + {RelocsDict, ConstTab} = extract_constants(RelocsDict0, ConstTab0, Obj), + %% Get relocation info + TextRelocs = elf_format:extract_rela(Obj, ?TEXT), + %% AccRefs contains the offsets of all references to relocatable symbols in + %% the code: + AccRefs = fix_relocations(TextRelocs, RelocsDict, MFA), + %% Get stack descriptors + SDescs = get_sdescs(Obj), + %% FixedSDescs are the stack descriptors after correcting calls that have + %% arguments in the stack + FixedSDescs = + fix_stack_descriptors(RelocsDict, AccRefs, SDescs, ExposedClosures), + Refs = AccRefs ++ FixedSDescs, + %% Get binary code from object file + BinCode = elf_format:extract_text(Obj), + %% Remove temp files (if needed) + ok = remove_temp_folder(Dir, Options), + %% Return the code together with information that will be used in the + %% hipe_llvm_merge module to produce the final binary that will be loaded + %% by the hipe unified loader. + {MFA, BinCode, byte_size(BinCode), ConstTab, Refs, LabelMap}. + +%%------------------------------------------------------------------------------ +%% LLVM tool chain +%%------------------------------------------------------------------------------ + +%% @doc Compile function FunName/Arity to LLVM. Return Dir (in order to remove +%% it if we do not want to store temporary files) and ObjectFile name that +%% is created by the LLVM tools. +compile_with_llvm(FunName, Arity, LLVMCode, Options, UseBuffer) -> + Filename = atom_to_list(FunName) ++ "_" ++ integer_to_list(Arity), + %% Save temp files in a unique folder + Dir = unique_folder(FunName, Arity, Options), + ok = file:make_dir(Dir), + %% Print LLVM assembly to file + OpenOpts = [append, raw] ++ + case UseBuffer of + %% true -> [delayed_write]; % Use delayed_write! + false -> [] + end, + {ok, File_llvm} = file:open(Dir ++ Filename ++ ".ll", OpenOpts), + Ver = hipe:get_llvm_version(), %% Should probably cache this + hipe_llvm:pp_ins_list(File_llvm, Ver, LLVMCode), + %% delayed_write can cause file:close not to do a close, hence the two calls + ok = file:close(File_llvm), + __ = file:close(File_llvm), + %% Invoke LLVM compiler tools to produce an object file + llvm_opt(Dir, Filename, Options), + llvm_llc(Dir, Filename, Options), + compile(Dir, Filename, "gcc"), %%FIXME: use llc -filetype=obj and skip this! + {ok, Dir, Dir ++ Filename ++ ".o"}. + +%% @doc Invoke opt tool to optimize the bitcode (_name.ll -> _name.bc). +llvm_opt(Dir, Filename, Options) -> + Source = Dir ++ Filename ++ ".ll", + Dest = Dir ++ Filename ++ ".bc", + OptLevel = trans_optlev_flag(opt, Options), + OptFlags = [OptLevel, "-mem2reg", "-strip"], + Command = "opt " ++ fix_opts(OptFlags) ++ " " ++ Source ++ " -o " ++ Dest, + %% io:format("OPT: ~s~n", [Command]), + case os:cmd(Command) of + "" -> ok; + Error -> exit({?MODULE, opt, Error}) + end. + +%% @doc Invoke llc tool to compile the bitcode to object file +%% (_name.bc -> _name.o). +llvm_llc(Dir, Filename, Options) -> + Source = Dir ++ Filename ++ ".bc", + OptLevel = trans_optlev_flag(llc, Options), + Align = find_stack_alignment(), + LlcFlags = [OptLevel, "-code-model=medium", "-stack-alignment=" ++ Align + , "-tailcallopt", "-filetype=asm"], %%FIXME + Command = "llc " ++ fix_opts(LlcFlags) ++ " " ++ Source, + %% io:format("LLC: ~s~n", [Command]), + case os:cmd(Command) of + "" -> ok; + Error -> exit({?MODULE, llc, Error}) + end. + +%% @doc Invoke the compiler tool ("gcc", "llvmc", etc.) to generate an object +%% file from native assembly. +compile(Dir, Fun_Name, Compiler) -> + Source = Dir ++ Fun_Name ++ ".s", + Dest = Dir ++ Fun_Name ++ ".o", + Command = Compiler ++ " -c " ++ Source ++ " -o " ++ Dest, + %% io:format("~s: ~s~n", [Compiler, Command]), + case os:cmd(Command) of + "" -> ok; + Error -> exit({?MODULE, cc, Error}) + end. + +find_stack_alignment() -> + case get(hipe_target_arch) of + x86 -> "4"; + amd64 -> "8"; + _ -> exit({?MODULE, find_stack_alignment, "Unimplemented architecture"}) + end. + +%% @doc Join options. +fix_opts(Opts) -> + string:join(Opts, " "). + +%% @doc Translate optimization-level flag (default is "O2"). +trans_optlev_flag(Tool, Options) -> + Flag = case Tool of + opt -> llvm_opt; + llc -> llvm_llc + end, + case proplists:get_value(Flag, Options) of + o0 -> ""; % "-O0" does not exist in opt tool + o1 -> "-O1"; + o2 -> "-O2"; + o3 -> "-O3"; + undefined -> "-O2" + end. + +%%------------------------------------------------------------------------------ +%% Functions to manage Relocations +%%------------------------------------------------------------------------------ + +%% @doc Get switch table and closure table. +-spec get_tables(elf_format:elf()) -> [elf_sym()]. +get_tables(Elf) -> + %% Search Symbol Table for entries where name is prefixed with "table_": + [S || S=#elf_sym{name="table_" ++ _} <- elf_format:elf_symbols(Elf)]. + +%% @doc This function associates symbols who point to some table of labels with +%% the corresponding offsets of the labels in the code. These tables can +%% either be jump tables for switches or a table which contains the labels +%% of blocks that contain closure calls with more than ?NR_ARG_REGS. +correlate_labels([], _L) -> {[], []}; +correlate_labels(Tables, Labels) -> + %% Assumes that the relocations are sorted + RelocTree = gb_trees:from_orddict( + [{Rel#elf_rel.offset, Rel#elf_rel.addend} || Rel <- Labels]), + %% Lookup all relocations pertaining to each symbol + NamesValues = [{Name, lookup_range(Value, Value+Size, RelocTree)} + || #elf_sym{name=Name, value=Value, size=Size} <- Tables], + case lists:keytake("table_closures", 1, NamesValues) of + false -> %% No closures in the code, no closure table + {NamesValues, []}; + {value, ClosureTableNV, SwitchesNV} -> + {SwitchesNV, ClosureTableNV} + end. + +%% Fetches all values with a key in [Low, Hi) +-spec lookup_range(_::K, _::K, gb_trees:tree(K,V)) -> [_::V]. +lookup_range(Low, Hi, Tree) -> + lookup_range_1(Hi, gb_trees:iterator_from(Low, Tree)). + +lookup_range_1(Hi, Iter0) -> + case gb_trees:next(Iter0) of + {Key, Value, Iter} when Key < Hi -> [Value | lookup_range_1(Hi, Iter)]; + _ -> [] + end. + +%% @doc Create a gb_tree which contains information about the labels that used +%% for switch's jump tables. The keys of the gb_tree are of the form +%% {MFA, Label} and the values are the actual Offsets. +create_labelmap(MFA, SwitchInfos, RelocsDict) -> + create_labelmap(MFA, SwitchInfos, RelocsDict, gb_trees:empty()). + +create_labelmap(_, [], _, LabelMap) -> LabelMap; +create_labelmap(MFA, [{Name, Offsets} | Rest], RelocsDict, LabelMap) -> + case dict:fetch(Name, RelocsDict) of + {switch, {_TableType, LabelList, _NrLabels, _SortOrder}, _JTabLab} -> + KVDict = lists:ukeysort(1, lists:zip(LabelList, Offsets)), + NewLabelMap = insert_to_labelmap(KVDict, LabelMap), + create_labelmap(MFA, Rest, RelocsDict, NewLabelMap); + _ -> + exit({?MODULE, create_labelmap, "Not a jump table!"}) + end. + +%% @doc Insert a list of [{Key,Value}] to a LabelMap (gb_tree). +insert_to_labelmap([], LabelMap) -> LabelMap; +insert_to_labelmap([{Key, Value}|Rest], LabelMap) -> + case gb_trees:lookup(Key, LabelMap) of + none -> + insert_to_labelmap(Rest, gb_trees:insert(Key, Value, LabelMap)); + {value, Value} -> %% Exists with the *exact* same Value. + insert_to_labelmap(Rest, LabelMap) + end. + +%% Find any LLVM-generated constants and add them to the constant table +extract_constants(RelocsDict0, ConstTab0, Obj) -> + TextRelocs = elf_format:extract_rela(Obj, ?TEXT), + AnonConstSections = + lists:usort([{Sec, Offset} + || #elf_rel{symbol=#elf_sym{type=section, section=Sec}, + addend=Offset} <- TextRelocs]), + lists:foldl( + fun({#elf_shdr{name=Name, type=progbits, addralign=Align, entsize=EntSize, + size=Size} = Section, Offset}, {RelocsDict1, ConstTab1}) + when EntSize > 0, 0 =:= Size rem EntSize, 0 =:= Offset rem EntSize -> + SectionBin = elf_format:section_contents(Section, Obj), + Constant = binary:part(SectionBin, Offset, EntSize), + {ConstTab, ConstLbl} = + hipe_consttab:insert_binary_const(ConstTab1, Align, Constant), + {dict:store({anon, Name, Offset}, {constant, ConstLbl}, RelocsDict1), + ConstTab} + end, {RelocsDict0, ConstTab0}, AnonConstSections). + +%% @doc Correlate object file relocation symbols with info from translation to +%% llvm code. +fix_relocations(Relocs, RelocsDict, MFA) -> + lists:map(fun(Reloc) -> fix_reloc(Reloc, RelocsDict, MFA) end, Relocs). + +%% Relocation types and expected addends for x86 and amd64 +-define(PCREL_T, 'pc32'). +-define(PCREL_A, -4). %% Hard-coded in hipe_x86.c and hipe_amd64.c +-ifdef(BIT32). +-define(ABS_T, '32'). +-define(ABS_A, _). %% We support any addend +-else. +-define(ABS_T, '64'). +-define(ABS_A, 0). +-endif. + +fix_reloc(#elf_rel{symbol=#elf_sym{name=Name, section=undefined, type=notype}, + offset=Offset, type=?PCREL_T, addend=?PCREL_A}, + RelocsDict, {ModName,_,_}) when Name =/= "" -> + case dict:fetch(Name, RelocsDict) of + {call, {bif, BifName, _}} -> {?CALL_LOCAL, Offset, BifName}; + %% MFA calls to functions in the same module are of type 3, while all + %% other MFA calls are of type 2. + %% XXX: Does this code break hot code loading (by transforming external + %% calls into local calls?) + {call, {ModName,_F,_A}=CallMFA} -> {?CALL_LOCAL, Offset, CallMFA}; + {call, CallMFA} -> {?CALL_REMOTE, Offset, CallMFA} + end; +fix_reloc(#elf_rel{symbol=#elf_sym{name=Name, section=undefined, type=notype}, + offset=Offset, type=?ABS_T, addend=?ABS_A}, + RelocsDict, _) when Name =/= "" -> + case dict:fetch(Name, RelocsDict) of + {atom, AtomName} -> {?LOAD_ATOM, Offset, AtomName}; + {constant, Label} -> {?LOAD_ADDRESS, Offset, {constant, Label}}; + {closure, _}=Closure -> {?LOAD_ADDRESS, Offset, Closure} + end; +fix_reloc(#elf_rel{symbol=#elf_sym{name=Name, section=#elf_shdr{name=?TEXT}, + type=func}, + offset=Offset, type=?PCREL_T, addend=?PCREL_A}, + RelocsDict, MFA) when Name =/= "" -> + case dict:fetch(Name, RelocsDict) of + {call, MFA} -> {?CALL_LOCAL, Offset, MFA} + end; +fix_reloc(#elf_rel{symbol=#elf_sym{name=Name, section=#elf_shdr{name=?RODATA}, + type=object}, + offset=Offset, type=?ABS_T, addend=?ABS_A}, + RelocsDict, _) when Name =/= "" -> + case dict:fetch(Name, RelocsDict) of + {switch, _, JTabLab} -> %% Treat switch exactly as constant + {?LOAD_ADDRESS, Offset, {constant, JTabLab}} + end; +fix_reloc(#elf_rel{symbol=#elf_sym{type=section, section=#elf_shdr{name=Name}}, + offset=Offset, type=?ABS_T, addend=Addend}, RelocsDict, _) -> + case dict:fetch({anon, Name, Addend}, RelocsDict) of + {constant, Label} -> {?LOAD_ADDRESS, Offset, {constant, Label}} + end. + +%%------------------------------------------------------------------------------ +%% Functions to manage Stack Descriptors +%%------------------------------------------------------------------------------ + +%% @doc This function takes an ELF Object File binary and returns a proper sdesc +%% list for Erlang/OTP System's loader. The return value should be of the +%% form: +%% { +%% 4, Safepoint Address, +%% {ExnLabel OR [], FrameSize, StackArity, {Liveroot stack frame indexes}}, +%% } +get_sdescs(Elf) -> + case elf_format:extract_note(Elf, ?NOTE_ERLGC_NAME) of + <<>> -> % Object file has no ".note.gc" section! + []; + NoteGC_bin -> + %% Get safe point addresses (stored in ".rela.note.gc" section): + RelaNoteGC = elf_format:extract_rela(Elf, ?NOTE(?NOTE_ERLGC_NAME)), + SPCount = length(RelaNoteGC), + T = SPCount * ?SP_ADDR_SIZE, + %% Pattern match fields of ".note.gc": + <<SPCount:(?bits(?SP_COUNT_SIZE))/integer-little, % Sanity check! + _SPAddrs:T/binary, % NOTE: In 64bit they are relocs! + StkFrameSize:(?bits(?SP_STKFRAME_SIZE))/integer-little, + StkArity:(?bits(?SP_STKARITY_SIZE))/integer-little, + _LiveRootCount:(?bits(?SP_LIVEROOTCNT_SIZE))/integer-little, % Skip + Roots/binary>> = NoteGC_bin, + LiveRoots = get_liveroots(Roots, []), + %% Extract the safe point offsets: + SPOffs = [A || #elf_rel{addend=A} <- RelaNoteGC], + %% Extract Exception Handler labels: + ExnHandlers = elf_format:get_exn_handlers(Elf), + %% Combine ExnHandlers and Safe point addresses (return addresses): + ExnAndSPOffs = combine_ras_and_exns(ExnHandlers, SPOffs, []), + create_sdesc_list(ExnAndSPOffs, StkFrameSize, StkArity, LiveRoots, []) + end. + +%% @doc Extracts a bunch of integers (live roots) from a binary. Returns a tuple +%% as need for stack descriptors. +get_liveroots(<<>>, Acc) -> + list_to_tuple(Acc); +get_liveroots(<<Root:?bits(?LR_STKINDEX_SIZE)/integer-little, + MoreRoots/binary>>, Acc) -> + get_liveroots(MoreRoots, [Root | Acc]). + +combine_ras_and_exns(_, [], Acc) -> + lists:reverse(Acc); +combine_ras_and_exns(ExnHandlers, [RA | MoreRAs], Acc) -> + %% FIXME: do something better than O(n^2) by taking advantage of the property + %% ||ExnHandlers|| <= ||RAs|| + Handler = find_exn_handler(RA, ExnHandlers), + combine_ras_and_exns(ExnHandlers, MoreRAs, [{Handler, RA} | Acc]). + +find_exn_handler(_, []) -> + []; +find_exn_handler(RA, [{Start, End, Handler} | MoreExnHandlers]) -> + case (RA >= Start andalso RA =< End) of + true -> + Handler; + false -> + find_exn_handler(RA, MoreExnHandlers) + end. + +create_sdesc_list([], _, _, _, Acc) -> + lists:reverse(Acc); +create_sdesc_list([{ExnLbl, SPOff} | MoreExnAndSPOffs], + StkFrameSize, StkArity, LiveRoots, Acc) -> + Hdlr = case ExnLbl of + 0 -> []; + N -> N + end, + create_sdesc_list(MoreExnAndSPOffs, StkFrameSize, StkArity, LiveRoots, + [{?SDESC, SPOff, {Hdlr, StkFrameSize, StkArity, LiveRoots}} + | Acc]). + +%% @doc This function is responsible for correcting the stack descriptors of +%% the calls that are found in the code and have more than NR_ARG_REGS +%% (thus, some of their arguments are passed to the stack). Because of the +%% Reserved Call Frame feature that the LLVM uses, the stack descriptors +%% are not correct since at the point of call the frame size is reduced +%% by the number of arguments that are passed on the stack. Also, the +%% offsets of the roots need to be re-adjusted. +fix_stack_descriptors(_, _, [], _) -> + []; +fix_stack_descriptors(RelocsDict, Relocs, SDescs, ExposedClosures) -> + %% NamedCalls are MFA and BIF calls that need fix + NamedCalls = calls_with_stack_args(RelocsDict), + NamedCallsOffs = calls_offsets_arity(Relocs, NamedCalls), + ExposedClosures1 = + case dict:is_key("table_closures", RelocsDict) of + true -> %% A Table with closures exists + {table_closures, ArityList} = dict:fetch("table_closures", RelocsDict), + case ExposedClosures of + {_, Offsets} -> + lists:zip(Offsets, ArityList); + _ -> + exit({?MODULE, fix_stack_descriptors, + {"Wrong exposed closures", ExposedClosures}}) + end; + false -> + [] + end, + ClosuresOffs = closures_offsets_arity(ExposedClosures1, SDescs), + fix_sdescs(NamedCallsOffs ++ ClosuresOffs, SDescs). + +%% @doc This function takes as argument the relocation dictionary as produced by +%% the translation of RTL code to LLVM and finds the names of the calls +%% (MFA and BIF calls) that have more than NR_ARG_REGS. +calls_with_stack_args(Dict) -> + calls_with_stack_args(dict:to_list(Dict), []). + +calls_with_stack_args([], Calls) -> Calls; +calls_with_stack_args([ {_Name, {call, {M, F, A}}} | Rest], Calls) + when A > ?NR_ARG_REGS -> + Call = + case M of + bif -> {F,A}; + _ -> {M,F,A} + end, + calls_with_stack_args(Rest, [Call|Calls]); +calls_with_stack_args([_|Rest], Calls) -> + calls_with_stack_args(Rest, Calls). + +%% @doc This function extracts the stack arity and the offset in the code of +%% the named calls (MFAs, BIFs) that have stack arguments. +calls_offsets_arity(AccRefs, CallsWithStackArgs) -> + calls_offsets_arity(AccRefs, CallsWithStackArgs, []). + +calls_offsets_arity([], _, Acc) -> Acc; +calls_offsets_arity([{Type, Offset, Term} | Rest], CallsWithStackArgs, Acc) + when Type =:= ?CALL_REMOTE orelse Type =:= ?CALL_LOCAL -> + case lists:member(Term, CallsWithStackArgs) of + true -> + Arity = + case Term of + {_M, _F, A} -> A; + {_F, A} -> A + end, + calls_offsets_arity(Rest, CallsWithStackArgs, + [{Offset + 4, Arity - ?NR_ARG_REGS} | Acc]); + false -> + calls_offsets_arity(Rest, CallsWithStackArgs, Acc) + end; +calls_offsets_arity([_|Rest], CallsWithStackArgs, Acc) -> + calls_offsets_arity(Rest, CallsWithStackArgs, Acc). + +%% @doc This function extracts the stack arity and the offsets of closures that +%% have stack arity. The Closures argument represents the +%% hipe_bifs:llvm_exposure_closure/0 calls in the code. The actual closure +%% is the next call in the code, so the offset of the next call must be +%% calculated from the stack descriptors. +closures_offsets_arity([], _) -> + []; +closures_offsets_arity(ExposedClosures, SDescs) -> + Offsets = [Offset || {_, Offset, _} <- SDescs], + %% Offsets and closures must be sorted in order for find_offsets/3 to work + SortedOffsets = lists:sort(Offsets), + SortedExposedClosures = lists:keysort(1, ExposedClosures), + find_offsets(SortedExposedClosures, SortedOffsets, []). + +find_offsets([], _, Acc) -> Acc; +find_offsets([{Off,Arity}|Rest], Offsets, Acc) -> + [I | RestOffsets] = lists:dropwhile(fun (Y) -> Y<Off end, Offsets), + find_offsets(Rest, RestOffsets, [{I, Arity}|Acc]). + +%% The function below corrects the stack descriptors of calls with arguments +%% that are passed on the stack (more than NR_ARG_REGS) by subtracting the +%% number of stacked arguments from the frame size and from the offset of the +%% roots. +fix_sdescs([], SDescs) -> SDescs; +fix_sdescs([{Offset, Arity} | Rest], SDescs) -> + case lists:keyfind(Offset, 2, SDescs) of + false -> + fix_sdescs(Rest, SDescs); + {?SDESC, Offset, {ExnHandler, FrameSize, StkArity, Roots}} -> + FixedRoots = list_to_tuple([Ri - Arity || Ri <- tuple_to_list(Roots)]), + FixedSDesc = + {?SDESC, Offset, {ExnHandler, FrameSize - Arity, StkArity, FixedRoots}}, + fix_sdescs(Rest, [FixedSDesc | lists:keydelete(Offset, 2, SDescs)]) + end. + +%%------------------------------------------------------------------------------ +%% Miscellaneous functions +%%------------------------------------------------------------------------------ + +%% @doc A function that opens a file as binary. The function takes as argument +%% the name of the file and returns an Erlang binary. +-spec open_object_file(string()) -> binary(). +open_object_file(ObjFile) -> + case file:read_file(ObjFile) of + {ok, Binary} -> + Binary; + {error, Reason} -> + exit({?MODULE, open_file, Reason}) + end. + +remove_temp_folder(Dir, Options) -> + case proplists:get_bool(llvm_save_temps, Options) of + true -> ok; + false -> spawn(fun () -> "" = os:cmd("rm -rf " ++ Dir) end), ok + end. + +unique_id(FunName, Arity) -> + integer_to_list(erlang:phash2({FunName, Arity, erlang:unique_integer()})). + +unique_folder(FunName, Arity, Options) -> + DirName = "llvm_" ++ unique_id(FunName, Arity) ++ "/", + Dir = + case proplists:get_bool(llvm_save_temps, Options) of + true -> %% Store folder in current directory + DirName; + false -> %% Temporarily store folder in tempfs (/dev/shm/) + "/dev/shm/" ++ DirName + end, + %% Make sure it does not exist + case dir_exists(Dir) of + true -> %% Dir already exists! Generate again. + unique_folder(FunName, Arity, Options); + false -> + Dir + end. + +%% @doc Function that checks that a given Filename is an existing Directory +%% Name (from http://rosettacode.org/wiki/Ensure_that_a_file_exists#Erlang) +dir_exists(Filename) -> + {Flag, Info} = file:read_file_info(Filename), + (Flag =:= ok) andalso (element(3, Info) =:= directory). diff --git a/lib/hipe/llvm/hipe_llvm_merge.erl b/lib/hipe/llvm/hipe_llvm_merge.erl new file mode 100644 index 0000000000..6e891ac3b0 --- /dev/null +++ b/lib/hipe/llvm/hipe_llvm_merge.erl @@ -0,0 +1,114 @@ +%%% -*- erlang-indent-level: 2 -*- +-module(hipe_llvm_merge). + +-export([finalize/3]). + +-include("hipe_llvm_arch.hrl"). +-include("../../kernel/src/hipe_ext_format.hrl"). +-include("../rtl/hipe_literals.hrl"). +-include("../main/hipe.hrl"). + +finalize(CompiledCode, Closures, Exports) -> + CompiledCode1 = [CodePack || {_, CodePack} <- CompiledCode], + Code = [{MFA, [], ConstTab} + || {MFA, _, _ , ConstTab, _, _} <- CompiledCode1], + {ConstAlign, ConstSize, ConstMap, RefsFromConsts} = + hipe_pack_constants:pack_constants(Code, ?ARCH_REGISTERS:alignment()), + %% Compute total code size separately as a sanity check for alignment + CodeSize = compute_code_size(CompiledCode1, 0), + %% io:format("Code Size (pre-computed): ~w~n", [CodeSize]), + {CodeBinary, ExportMap} = merge_mfas(CompiledCode1, 0, <<>>, []), + %% io:format("Code Size (post-computed): ~w~n", [byte_size(CodeBinary)]), + ?VERBOSE_ASSERT(CodeSize =:= byte_size(CodeBinary)), + AccRefs = merge_refs(CompiledCode1, ConstMap, 0, []), + %% Bring CompiledCode to a combine_label_maps-acceptable form. + LabelMap = combine_label_maps(CompiledCode1, 0, gb_trees:empty()), + SC = hipe_pack_constants:slim_constmap(ConstMap), + DataRelocs = hipe_pack_constants:mk_data_relocs(RefsFromConsts, LabelMap), + SSE = hipe_pack_constants:slim_sorted_exportmap(ExportMap, Closures, Exports), + SlimRefs = hipe_pack_constants:slim_refs(AccRefs), + term_to_binary([{?VERSION_STRING(),?HIPE_ERTS_CHECKSUM}, + ConstAlign, ConstSize, + SC, % ConstMap + DataRelocs, % LabelMap + SSE, % ExportMap + CodeSize, CodeBinary, SlimRefs, + 0,[] % ColdCodeSize, SlimColdRefs + ]). + +%% Copied from hipe_x86_assemble.erl +nr_pad_bytes(Address) -> + (4 - (Address rem 4)) rem 4. % XXX: 16 or 32 instead? + +align_entry(Address) -> + Address + nr_pad_bytes(Address). + +compute_code_size([{_MFA, _BinaryCode, CodeSize, _, _, _}|Code], Size) -> + compute_code_size(Code, align_entry(Size+CodeSize)); +compute_code_size([], Size) -> Size. + +combine_label_maps([{MFA, _, CodeSize, _, _, LabelMap}|Code], Address, CLM) -> + NewCLM = merge_label_map(gb_trees:to_list(LabelMap), MFA, Address, CLM), + combine_label_maps(Code, align_entry(Address+CodeSize), NewCLM); +combine_label_maps([], _Address, CLM) -> CLM. + +merge_label_map([{Label,Offset}|Rest], MFA, Address, CLM) -> + NewCLM = gb_trees:insert({MFA,Label}, Address+Offset, CLM), + merge_label_map(Rest, MFA, Address, NewCLM); +merge_label_map([], _MFA, _Address, CLM) -> CLM. + +%% @doc Merge the MFAs' binary code to one continuous binary and compute the +%% size of this binary. At the same time create an exportmap in a form +%% of {Address, M, F, A}. +%% XXX: Is alignment correct/optimal for X86/AMD64? +merge_mfas([{{M,F,A}, CodeBinary, CodeSize, _, _, _}|Code], + Address, AccCode, AccExportMap) -> + ?VERBOSE_ASSERT(CodeSize =:= byte_size(CodeBinary)), + {Address1, Code1} = + case nr_pad_bytes(Address + CodeSize) of + 0 -> %% Retains alignment: + {Address + CodeSize, CodeBinary}; + NrPadBytes -> %% Needs padding! + Padding = list_to_binary(lists:duplicate(NrPadBytes, 0)), + {Address + CodeSize + NrPadBytes, % =:= align_entry(Address+CodeSize) + <<CodeBinary/binary, Padding/binary>>} + end, + ?VERBOSE_ASSERT(Address1 =:= + align_entry(Address + CodeSize)), %XXX: Should address be aligned? + AccCode1 = <<AccCode/binary, Code1/binary>>, + merge_mfas(Code, Address1, AccCode1, [{Address, M, F, A}|AccExportMap]); +merge_mfas([], _Address, AccCode, AccExportMap) -> + {AccCode, AccExportMap}. + +%% @doc Merge the references of relocatable symbols in the binary code. The +%% offsets must be updated because of the merging of the code binaries! +merge_refs([], _ConstMap, _Addr, AccRefs) -> AccRefs; +merge_refs([{MFA, _, CodeSize, _, Refs, _}|Rest], ConstMap, Address, AccRefs) -> + %% Important!: The hipe_pack_constants:pack_constants/2 function assignes + %% unique numbers to constants (ConstNo). This numbers are used from now on, + %% instead of labels that were used before. So, in order to be compatible, we + %% must change all the constant labels in the Refs to the corresponding + %% ConstNo, that can be found in the ConstMap (#pcm_entry{}). + UpdatedRefs = [update_ref(label_to_constno(Ref, MFA, ConstMap), Address) + || Ref <- Refs], + merge_refs(Rest, ConstMap, align_entry(Address+CodeSize), + UpdatedRefs++AccRefs). + +label_to_constno({Type, Offset, {constant, Label}}, MFA, ConstMap) -> + ConstNo = hipe_pack_constants:find_const({MFA, Label}, ConstMap), + {Type, Offset, {constant, ConstNo}}; +label_to_constno(Other, _MFA, _ConstMap) -> + Other. + +%% @doc Update offset to a reference. In case of stack descriptors we must check +%% if there exists an exception handler, because it must also be updated. +update_ref({?SDESC, Offset, SDesc}, CodeAddr) -> + NewRefAddr = Offset+CodeAddr, + case SDesc of + {[], _, _, _} -> % No handler; only update offset + {?SDESC, NewRefAddr, SDesc}; + {ExnHandler, FrameSize, StackArity, Roots} -> % Update exception handler + {?SDESC, NewRefAddr, {ExnHandler+CodeAddr, FrameSize, StackArity, Roots}} + end; +update_ref({Type, Offset, Term}, CodeAddr) -> + {Type, Offset+CodeAddr, Term}. diff --git a/lib/hipe/llvm/hipe_rtl_to_llvm.erl b/lib/hipe/llvm/hipe_rtl_to_llvm.erl new file mode 100644 index 0000000000..66b2e10fb8 --- /dev/null +++ b/lib/hipe/llvm/hipe_rtl_to_llvm.erl @@ -0,0 +1,1630 @@ +%% -*- erlang-indent-level: 2 -*- + +-module(hipe_rtl_to_llvm). +-author("Chris Stavrakakis, Yiannis Tsiouris"). + +-export([translate/2]). % the main function of this module +-export([fix_mfa_name/1]). % a help function used in hipe_llvm_main + +-include("../rtl/hipe_rtl.hrl"). +-include("../rtl/hipe_literals.hrl"). +-include("hipe_llvm_arch.hrl"). + +-define(WORD_WIDTH, (?bytes_to_bits(hipe_rtl_arch:word_size()))). +-define(BRANCH_META_TAKEN, "0"). +-define(BRANCH_META_NOT_TAKEN, "1"). +-define(FIRST_FREE_META_NO, 2). +-define(HIPE_LITERALS_META, "hipe.literals"). + +%%------------------------------------------------------------------------------ +%% @doc Main function for translating an RTL function to LLVM Assembly. Takes as +%% input the RTL code and the variable indexes of possible garbage +%% collection roots and returns the corresponing LLVM, a dictionary with +%% all the relocations in the code and a hipe_consttab() with informaton +%% about data. +%%------------------------------------------------------------------------------ +translate(RTL, Roots) -> + Fun = hipe_rtl:rtl_fun(RTL), + Params = hipe_rtl:rtl_params(RTL), + Data = hipe_rtl:rtl_data(RTL), + Code = hipe_rtl:rtl_code(RTL), + %% Init unique symbol generator and initialize the label counter to the last + %% RTL label. + hipe_gensym:init(llvm), + {_, MaxLabel} = hipe_rtl:rtl_label_range(RTL), + put({llvm,label_count}, MaxLabel + 1), + %% Put first label of RTL code in process dictionary + find_code_entry_label(Code), + %% Initialize relocations symbol dictionary + Relocs = dict:new(), + %% Print RTL to file + %% {ok, File_rtl} = file:open("rtl_" ++integer_to_list(random:uniform(2000)) + %% ++ ".rtl", [write]), + %% hipe_rtl:pp(File_rtl, RTL), + %% file:close(File_rtl), + + %% Pass on RTL code to handle exception handling and identify labels of Fail + %% Blocks + {Code1, FailLabels} = fix_code(Code), + %% Allocate stack slots for each virtual register and declare gc roots + AllocaStackCode = alloca_stack(Code1, Params, Roots), + %% Translate Code + {LLVM_Code1, Relocs1, NewData} = + translate_instr_list(Code1, [], Relocs, Data), + %% Create LLVM code to declare relocation symbols as external symbols along + %% with local variables in order to use them as just any other variable + {FinalRelocs, ExternalDecl0, LocalVars} = + handle_relocations(Relocs1, Data, Fun), + ExternalDecl = add_literals_metadata(ExternalDecl0), + %% Pass on LLVM code in order to create Fail blocks and a landingpad + %% instruction to each one + LLVM_Code2 = add_landingpads(LLVM_Code1, FailLabels), + %% Create LLVM Code for the compiled function + LLVM_Code3 = create_function_definition(Fun, Params, LLVM_Code2, + AllocaStackCode ++ LocalVars), + %% Final Code = CompiledFunction + External Declarations + FinalLLVMCode = [LLVM_Code3 | ExternalDecl], + {FinalLLVMCode, FinalRelocs, NewData}. + +find_code_entry_label([]) -> + exit({?MODULE, find_code_entry_label, "Empty code"}); +find_code_entry_label([I|_]) -> + case hipe_rtl:is_label(I) of + true -> + put(first_label, hipe_rtl:label_name(I)); + false -> + exit({?MODULE, find_code_entry_label, "First instruction is not a label"}) + end. + +%% @doc Create a stack slot for each virtual register. The stack slots +%% that correspond to possible garbage collection roots must be +%% marked as such. +alloca_stack(Code, Params, Roots) -> + %% Find all assigned virtual registers + Destinations = collect_destinations(Code), + %% Declare virtual registers, and declare garbage collection roots + do_alloca_stack(Destinations++Params, Params, Roots). + +collect_destinations(Code) -> + lists:usort(lists:flatmap(fun insn_dst/1, Code)). + +do_alloca_stack(Destinations, Params, Roots) -> + do_alloca_stack(Destinations, Params, Roots, []). + +do_alloca_stack([], _, _, Acc) -> + Acc; +do_alloca_stack([D|Ds], Params, Roots, Acc) -> + {Name, _I} = trans_dst(D), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(8)), + case hipe_rtl:is_var(D) of + true -> + Num = hipe_rtl:var_index(D), + I1 = hipe_llvm:mk_alloca(Name, WordTy, [], []), + case lists:member(Num, Roots) of + true -> %% Variable is a possible Root + T1 = mk_temp(), + BYTE_TYPE_PP = hipe_llvm:mk_pointer(ByteTyPtr), + I2 = + hipe_llvm:mk_conversion(T1, bitcast, WordTyPtr, Name, BYTE_TYPE_PP), + GcRootArgs = [{BYTE_TYPE_PP, T1}, {ByteTyPtr, "@gc_metadata"}], + I3 = hipe_llvm:mk_call([], false, [], [], hipe_llvm:mk_void(), + "@llvm.gcroot", GcRootArgs, []), + I4 = case lists:member(D, Params) of + false -> + hipe_llvm:mk_store(WordTy, "-5", WordTyPtr, Name, + [], [], false); + true -> [] + end, + do_alloca_stack(Ds, Params, Roots, [I1, I2, I3, I4 | Acc]); + false -> + do_alloca_stack(Ds, Params, Roots, [I1|Acc]) + end; + false -> + case hipe_rtl:is_reg(D) andalso isPrecoloured(D) of + true -> %% Precoloured registers are mapped to "special" stack slots + do_alloca_stack(Ds, Params, Roots, Acc); + false -> + I1 = case hipe_rtl:is_fpreg(D) of + true -> + FloatTy = hipe_llvm:mk_double(), + hipe_llvm:mk_alloca(Name, FloatTy, [], []); + false -> hipe_llvm:mk_alloca(Name, WordTy, [], []) + end, + do_alloca_stack(Ds, Params, Roots, [I1|Acc]) + end + end. + +%%------------------------------------------------------------------------------ +%% @doc Translation of the linearized RTL Code. Each RTL instruction is +%% translated to a list of LLVM Assembly instructions. The relocation +%% dictionary is updated when needed. +%%------------------------------------------------------------------------------ +translate_instr_list([], Acc, Relocs, Data) -> + {lists:reverse(lists:flatten(Acc)), Relocs, Data}; +translate_instr_list([I | Is], Acc, Relocs, Data) -> + {Acc1, NewRelocs, NewData} = translate_instr(I, Relocs, Data), + translate_instr_list(Is, [Acc1 | Acc], NewRelocs, NewData). + +translate_instr(I, Relocs, Data) -> + case I of + #alu{} -> + {I2, Relocs2} = trans_alu(I, Relocs), + {I2, Relocs2, Data}; + #alub{} -> + {I2, Relocs2} = trans_alub(I, Relocs), + {I2, Relocs2, Data}; + #branch{} -> + {I2, Relocs2} = trans_branch(I, Relocs), + {I2, Relocs2, Data}; + #call{} -> + {I2, Relocs2} = + case hipe_rtl:call_fun(I) of + %% In AMD64 this instruction does nothing! + %% TODO: chech use of fwait in other architectures! + fwait -> + {[], Relocs}; + _ -> + trans_call(I, Relocs) + end, + {I2, Relocs2, Data}; + #comment{} -> + {I2, Relocs2} = trans_comment(I, Relocs), + {I2, Relocs2, Data}; + #enter{} -> + {I2, Relocs2} = trans_enter(I, Relocs), + {I2, Relocs2, Data}; + #fconv{} -> + {I2, Relocs2} = trans_fconv(I, Relocs), + {I2, Relocs2, Data}; + #fload{} -> + {I2, Relocs2} = trans_fload(I, Relocs), + {I2, Relocs2, Data}; + #fmove{} -> + {I2, Relocs2} = trans_fmove(I, Relocs), + {I2, Relocs2, Data}; + #fp{} -> + {I2, Relocs2} = trans_fp(I, Relocs), + {I2, Relocs2, Data}; + #fp_unop{} -> + {I2, Relocs2} = trans_fp_unop(I, Relocs), + {I2, Relocs2, Data}; + #fstore{} -> + {I2, Relocs2} = trans_fstore(I, Relocs), + {I2, Relocs2, Data}; + #goto{} -> + {I2, Relocs2} = trans_goto(I, Relocs), + {I2, Relocs2, Data}; + #label{} -> + {I2, Relocs2} = trans_label(I, Relocs), + {I2, Relocs2, Data}; + #load{} -> + {I2, Relocs2} = trans_load(I, Relocs), + {I2, Relocs2, Data}; + #load_address{} -> + {I2, Relocs2} = trans_load_address(I, Relocs), + {I2, Relocs2, Data}; + #load_atom{} -> + {I2, Relocs2} = trans_load_atom(I, Relocs), + {I2, Relocs2, Data}; + #move{} -> + {I2, Relocs2} = trans_move(I, Relocs), + {I2, Relocs2, Data}; + #return{} -> + {I2, Relocs2} = trans_return(I, Relocs), + {I2, Relocs2, Data}; + #store{} -> + {I2, Relocs2} = trans_store(I, Relocs), + {I2, Relocs2, Data}; + #switch{} -> %% Only switch instruction updates Data + {I2, Relocs2, NewData} = trans_switch(I, Relocs, Data), + {I2, Relocs2, NewData}; + Other -> + exit({?MODULE, translate_instr, {"Unknown RTL instruction", Other}}) + end. + +%% +%% alu +%% +trans_alu(I, Relocs) -> + RtlDst = hipe_rtl:alu_dst(I), + TmpDst = mk_temp(), + {Src1, I1} = trans_src(hipe_rtl:alu_src1(I)), + {Src2, I2} = trans_src(hipe_rtl:alu_src2(I)), + Op = trans_op(hipe_rtl:alu_op(I)), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + I3 = hipe_llvm:mk_operation(TmpDst, Op, WordTy, Src1, Src2, []), + I4 = store_stack_dst(TmpDst, RtlDst), + {[I4, I3, I2, I1], Relocs}. + +%% +%% alub +%% +trans_alub(I, Relocs) -> + case hipe_rtl:alub_cond(I) of + Op when Op =:= overflow orelse Op =:= not_overflow -> + trans_alub_overflow(I, signed, Relocs); + ltu -> %% ltu means unsigned overflow + trans_alub_overflow(I, unsigned, Relocs); + _ -> + trans_alub_no_overflow(I, Relocs) + end. + +trans_alub_overflow(I, Sign, Relocs) -> + {Src1, I1} = trans_src(hipe_rtl:alub_src1(I)), + {Src2, I2} = trans_src(hipe_rtl:alub_src2(I)), + RtlDst = hipe_rtl:alub_dst(I), + TmpDst = mk_temp(), + Name = trans_alub_op(I, Sign), + NewRelocs = relocs_store(Name, {call, {llvm, Name, 2}}, Relocs), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + ReturnType = hipe_llvm:mk_struct([WordTy, hipe_llvm:mk_int(1)]), + T1 = mk_temp(), + I3 = hipe_llvm:mk_call(T1, false, [], [], ReturnType, "@" ++ Name, + [{WordTy, Src1}, {WordTy, Src2}], []), + %% T1{0}: result of the operation + I4 = hipe_llvm:mk_extractvalue(TmpDst, ReturnType, T1 , "0", []), + I5 = store_stack_dst(TmpDst, RtlDst), + T2 = mk_temp(), + %% T1{1}: Boolean variable indicating overflow + I6 = hipe_llvm:mk_extractvalue(T2, ReturnType, T1, "1", []), + {TrueLabel, FalseLabel, MetaData} = + case hipe_rtl:alub_cond(I) of + Op when Op =:= overflow orelse Op =:= ltu -> + {mk_jump_label(hipe_rtl:alub_true_label(I)), + mk_jump_label(hipe_rtl:alub_false_label(I)), + branch_metadata(hipe_rtl:alub_pred(I))}; + not_overflow -> + {mk_jump_label(hipe_rtl:alub_false_label(I)), + mk_jump_label(hipe_rtl:alub_true_label(I)), + branch_metadata(1 - hipe_rtl:alub_pred(I))} + end, + I7 = hipe_llvm:mk_br_cond(T2, TrueLabel, FalseLabel, MetaData), + {[I7, I6, I5, I4, I3, I2, I1], NewRelocs}. + +trans_alub_op(I, Sign) -> + Name = + case Sign of + signed -> + case hipe_rtl:alub_op(I) of + add -> "llvm.sadd.with.overflow."; + mul -> "llvm.smul.with.overflow."; + sub -> "llvm.ssub.with.overflow."; + Op -> exit({?MODULE, trans_alub_op, {"Unknown alub operator", Op}}) + end; + unsigned -> + case hipe_rtl:alub_op(I) of + add -> "llvm.uadd.with.overflow."; + mul -> "llvm.umul.with.overflow."; + sub -> "llvm.usub.with.overflow."; + Op -> exit({?MODULE, trans_alub_op, {"Unknown alub operator", Op}}) + end + end, + Type = + case hipe_rtl_arch:word_size() of + 4 -> "i32"; + 8 -> "i64" + %% Other -> exit({?MODULE, trans_alub_op, {"Unknown type", Other}}) + end, + Name ++ Type. + +trans_alub_no_overflow(I, Relocs) -> + %% alu + T = hipe_rtl:mk_alu(hipe_rtl:alub_dst(I), hipe_rtl:alub_src1(I), + hipe_rtl:alub_op(I), hipe_rtl:alub_src2(I)), + %% A trans_alu instruction cannot change relocations + {I1, _} = trans_alu(T, Relocs), + %% icmp + %% Translate destination as src, to match with the semantics of instruction + {Dst, I2} = trans_src(hipe_rtl:alub_dst(I)), + Cond = trans_rel_op(hipe_rtl:alub_cond(I)), + T3 = mk_temp(), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + I5 = hipe_llvm:mk_icmp(T3, Cond, WordTy, Dst, "0"), + %% br + Metadata = branch_metadata(hipe_rtl:alub_pred(I)), + True_label = mk_jump_label(hipe_rtl:alub_true_label(I)), + False_label = mk_jump_label(hipe_rtl:alub_false_label(I)), + I6 = hipe_llvm:mk_br_cond(T3, True_label, False_label, Metadata), + {[I6, I5, I2, I1], Relocs}. + +%% +%% branch +%% +trans_branch(I, Relocs) -> + {Src1, I1} = trans_src(hipe_rtl:branch_src1(I)), + {Src2, I2} = trans_src(hipe_rtl:branch_src2(I)), + Cond = trans_rel_op(hipe_rtl:branch_cond(I)), + %% icmp + T1 = mk_temp(), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + I3 = hipe_llvm:mk_icmp(T1, Cond, WordTy, Src1, Src2), + %% br + True_label = mk_jump_label(hipe_rtl:branch_true_label(I)), + False_label = mk_jump_label(hipe_rtl:branch_false_label(I)), + Metadata = branch_metadata(hipe_rtl:branch_pred(I)), + I4 = hipe_llvm:mk_br_cond(T1, True_label, False_label, Metadata), + {[I4, I3, I2, I1], Relocs}. + +branch_metadata(X) when X =:= 0.5 -> []; +branch_metadata(X) when X > 0.5 -> ?BRANCH_META_TAKEN; +branch_metadata(X) when X < 0.5 -> ?BRANCH_META_NOT_TAKEN. + +%% +%% call +%% +trans_call(I, Relocs) -> + RtlCallArgList= hipe_rtl:call_arglist(I), + RtlCallName = hipe_rtl:call_fun(I), + {I0, Relocs1} = expose_closure(RtlCallName, RtlCallArgList, Relocs), + TmpDst = mk_temp(), + {CallArgs, I1} = trans_call_args(RtlCallArgList), + FixedRegs = fixed_registers(), + {LoadedFixedRegs, I2} = load_fixed_regs(FixedRegs), + FinalArgs = fix_reg_args(LoadedFixedRegs) ++ CallArgs, + {Name, I3, Relocs2} = + trans_call_name(RtlCallName, Relocs1, CallArgs, FinalArgs), + T1 = mk_temp(), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + FunRetTy = hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), + I4 = + case hipe_rtl:call_fail(I) of + %% Normal Call + [] -> + hipe_llvm:mk_call(T1, false, "cc 11", [], FunRetTy, Name, FinalArgs, + []); + %% Call With Exception + FailLabelNum -> + TrueLabel = "L" ++ integer_to_list(hipe_rtl:call_normal(I)), + FailLabel = "%FL" ++ integer_to_list(FailLabelNum), + II1 = + hipe_llvm:mk_invoke(T1, "cc 11", [], FunRetTy, Name, FinalArgs, [], + "%" ++ TrueLabel, FailLabel), + II2 = hipe_llvm:mk_label(TrueLabel), + [II2, II1] + end, + I5 = store_fixed_regs(FixedRegs, T1), + I6 = + case hipe_rtl:call_dstlist(I) of + [] -> []; %% No return value + [Destination] -> + II3 = + hipe_llvm:mk_extractvalue(TmpDst, FunRetTy, T1, + integer_to_list(?NR_PINNED_REGS), []), + II4 = store_stack_dst(TmpDst, Destination), + [II4, II3] + end, + I7 = + case hipe_rtl:call_continuation(I) of + [] -> []; %% No continuation + CC -> + {II5, _} = trans_goto(hipe_rtl:mk_goto(CC), Relocs2), + II5 + end, + {[I7, I6, I5, I4, I3, I2, I1, I0], Relocs2}. + +%% In case of call to a register (closure call) with more than ?NR_ARG_REGS +%% arguments we must track the offset this call in the code, in order to +%% to correct the stack descriptor. So, we insert a new Label and add this label +%% to the "table_closures" +%% --------------------------------|-------------------------------------------- +%% Old Code | New Code +%% --------------------------------|-------------------------------------------- +%% | br %ClosureLabel +%% call %reg(Args) | ClosureLabel: +%% | call %reg(Args) +expose_closure(CallName, CallArgs, Relocs) -> + CallArgsNr = length(CallArgs), + case hipe_rtl:is_reg(CallName) andalso CallArgsNr > ?NR_ARG_REGS of + true -> + LabelNum = hipe_gensym:new_label(llvm), + ClosureLabel = hipe_llvm:mk_label(mk_label(LabelNum)), + JumpIns = hipe_llvm:mk_br(mk_jump_label(LabelNum)), + Relocs1 = + relocs_store({CallName, LabelNum}, + {closure_label, LabelNum, CallArgsNr - ?NR_ARG_REGS}, + Relocs), + {[ClosureLabel, JumpIns], Relocs1}; + false -> + {[], Relocs} + end. + +trans_call_name(RtlCallName, Relocs, CallArgs, FinalArgs) -> + case RtlCallName of + PrimOp when is_atom(PrimOp) -> + LlvmName = trans_prim_op(PrimOp), + Relocs1 = + relocs_store(LlvmName, {call, {bif, PrimOp, length(CallArgs)}}, Relocs), + {"@" ++ LlvmName, [], Relocs1}; + {M, F, A} when is_atom(M), is_atom(F), is_integer(A) -> + LlvmName = trans_mfa_name({M, F, A}), + Relocs1 = + relocs_store(LlvmName, {call, {M, F, length(CallArgs)}}, Relocs), + {"@" ++ LlvmName, [], Relocs1}; + Reg -> + case hipe_rtl:is_reg(Reg) of + true -> + %% In case of a closure call, the register holding the address + %% of the closure must be converted to function type in + %% order to make the call + TT1 = mk_temp(), + {RegName, II1} = trans_src(Reg), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + II2 = + hipe_llvm:mk_conversion(TT1, inttoptr, WordTy, RegName, WordTyPtr), + TT2 = mk_temp(), + ArgsTypeList = lists:duplicate(length(FinalArgs), WordTy), + FunRetTy = + hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), + FunType = hipe_llvm:mk_fun(FunRetTy, ArgsTypeList), + FunTypeP = hipe_llvm:mk_pointer(FunType), + II3 = hipe_llvm:mk_conversion(TT2, bitcast, WordTyPtr, TT1, FunTypeP), + {TT2, [II3, II2, II1], Relocs}; + false -> + exit({?MODULE, trans_call, {"Unimplemented call to", RtlCallName}}) + end + end. + +%% +trans_call_args(ArgList) -> + {Args, I} = lists:unzip(trans_args(ArgList)), + %% Reverse arguments that are passed to stack to match with the Erlang + %% calling convention. (Propably not needed in prim calls.) + ReversedArgs = + case erlang:length(Args) > ?NR_ARG_REGS of + false -> + Args; + true -> + {ArgsInRegs, ArgsInStack} = lists:split(?NR_ARG_REGS, Args), + ArgsInRegs ++ lists:reverse(ArgsInStack) + end, + %% Reverse I, because some of the arguments may go out of scope and + %% should be killed(store -5). When two or more arguments are they + %% same, then order matters! + {ReversedArgs, lists:reverse(I)}. + +%% +%% trans_comment +%% +trans_comment(I, Relocs) -> + I1 = hipe_llvm:mk_comment(hipe_rtl:comment_text(I)), + {I1, Relocs}. + +%% +%% enter +%% +trans_enter(I, Relocs) -> + {CallArgs, I0} = trans_call_args(hipe_rtl:enter_arglist(I)), + FixedRegs = fixed_registers(), + {LoadedFixedRegs, I1} = load_fixed_regs(FixedRegs), + FinalArgs = fix_reg_args(LoadedFixedRegs) ++ CallArgs, + {Name, I2, NewRelocs} = + trans_call_name(hipe_rtl:enter_fun(I), Relocs, CallArgs, FinalArgs), + T1 = mk_temp(), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + FunRetTy = hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), + I3 = hipe_llvm:mk_call(T1, true, "cc 11", [], FunRetTy, Name, FinalArgs, []), + I4 = hipe_llvm:mk_ret([{FunRetTy, T1}]), + {[I4, I3, I2, I1, I0], NewRelocs}. + +%% +%% fconv +%% +trans_fconv(I, Relocs) -> + %% XXX: Can a fconv destination be a precoloured reg? + RtlDst = hipe_rtl:fconv_dst(I), + TmpDst = mk_temp(), + {Src, I1} = trans_float_src(hipe_rtl:fconv_src(I)), + FloatTy = hipe_llvm:mk_double(), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + I2 = hipe_llvm:mk_conversion(TmpDst, sitofp, WordTy, Src, FloatTy), + I3 = store_float_stack(TmpDst, RtlDst), + {[I3, I2, I1], Relocs}. + + +%% TODO: fload, fstore, fmove, and fp are almost the same with load, store, move +%% and alu. Maybe we should join them. + +%% +%% fload +%% +trans_fload(I, Relocs) -> + RtlDst = hipe_rtl:fload_dst(I), + RtlSrc = hipe_rtl:fload_src(I), + _Offset = hipe_rtl:fload_offset(I), + TmpDst = mk_temp(), + {Src, I1} = trans_float_src(RtlSrc), + {Offset, I2} = trans_float_src(_Offset), + T1 = mk_temp(), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + FloatTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_double()), + I3 = hipe_llvm:mk_operation(T1, add, WordTy, Src, Offset, []), + T2 = mk_temp(), + I4 = hipe_llvm:mk_conversion(T2, inttoptr, WordTy, T1, FloatTyPtr), + I5 = hipe_llvm:mk_load(TmpDst, FloatTyPtr, T2, [], [], false), + I6 = store_float_stack(TmpDst, RtlDst), + {[I6, I5, I4, I3, I2, I1], Relocs}. + +%% +%% fmove +%% +trans_fmove(I, Relocs) -> + RtlDst = hipe_rtl:fmove_dst(I), + RtlSrc = hipe_rtl:fmove_src(I), + {Src, I1} = trans_float_src(RtlSrc), + I2 = store_float_stack(Src, RtlDst), + {[I2, I1], Relocs}. + +%% +%% fp +%% +trans_fp(I, Relocs) -> + %% XXX: Just copied trans_alu...think again.. + RtlDst = hipe_rtl:fp_dst(I), + RtlSrc1 = hipe_rtl:fp_src1(I), + RtlSrc2 = hipe_rtl:fp_src2(I), + %% Destination cannot be a precoloured register + FloatTy = hipe_llvm:mk_double(), + FloatTyPtr = hipe_llvm:mk_pointer(FloatTy), + TmpDst = mk_temp(), + {Src1, I1} = trans_float_src(RtlSrc1), + {Src2, I2} = trans_float_src(RtlSrc2), + Op = trans_fp_op(hipe_rtl:fp_op(I)), + I3 = hipe_llvm:mk_operation(TmpDst, Op, FloatTy, Src1, Src2, []), + I4 = store_float_stack(TmpDst, RtlDst), + %% Synchronization for floating point exceptions + I5 = hipe_llvm:mk_store(FloatTy, TmpDst, FloatTyPtr, "%exception_sync", [], + [], true), + T1 = mk_temp(), + I6 = hipe_llvm:mk_load(T1, FloatTyPtr, "%exception_sync", [], [], true), + {[I6, I5, I4, I3, I2, I1], Relocs}. + +%% +%% fp_unop +%% +trans_fp_unop(I, Relocs) -> + RtlDst = hipe_rtl:fp_unop_dst(I), + RtlSrc = hipe_rtl:fp_unop_src(I), + %% Destination cannot be a precoloured register + TmpDst = mk_temp(), + {Src, I1} = trans_float_src(RtlSrc), + Op = trans_fp_op(hipe_rtl:fp_unop_op(I)), + FloatTy = hipe_llvm:mk_double(), + I2 = hipe_llvm:mk_operation(TmpDst, Op, FloatTy, "0.0", Src, []), + I3 = store_float_stack(TmpDst, RtlDst), + {[I3, I2, I1], Relocs}. +%% TODO: Fix fp_unop in a way like the following. You must change trans_dest, +%% in order to call float_to_list in a case of float constant. Maybe the type +%% check is expensive... +%% Dst = hipe_rtl:fp_unop_dst(I), +%% Src = hipe_rtl:fp_unop_src(I), +%% Op = hipe_rtl:fp_unop_op(I), +%% Zero = hipe_rtl:mk_imm(0.0), +%% I1 = hipe_rtl:mk_fp(Dst, Zero, Op, Src), +%% trans_fp(I, Relocs1). + +%% +%% fstore +%% +trans_fstore(I, Relocs) -> + Base = hipe_rtl:fstore_base(I), + case isPrecoloured(Base) of + true -> + trans_fstore_reg(I, Relocs); + false -> + exit({?MODULE, trans_fstore ,{"Not implemented yet", false}}) + end. + +trans_fstore_reg(I, Relocs) -> + {Base, I0} = trans_reg(hipe_rtl:fstore_base(I), dst), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + FloatTy = hipe_llvm:mk_double(), + FloatTyPtr = hipe_llvm:mk_pointer(FloatTy), + T1 = mk_temp(), + I1 = hipe_llvm:mk_load(T1, WordTyPtr, Base, [], [], false), + {Offset, I2} = trans_src(hipe_rtl:fstore_offset(I)), + T2 = mk_temp(), + I3 = hipe_llvm:mk_operation(T2, add, WordTy, T1, Offset, []), + T3 = mk_temp(), + I4 = hipe_llvm:mk_conversion(T3, inttoptr, WordTy, T2, FloatTyPtr), + {Value, I5} = trans_src(hipe_rtl:fstore_src(I)), + I6 = hipe_llvm:mk_store(FloatTy, Value, FloatTyPtr, T3, [], [], false), + {[I6, I5, I4, I3, I2, I1, I0], Relocs}. + +%% +%% goto +%% +trans_goto(I, Relocs) -> + I1 = hipe_llvm:mk_br(mk_jump_label(hipe_rtl:goto_label(I))), + {I1, Relocs}. + +%% +%% label +%% +trans_label(I, Relocs) -> + Label = mk_label(hipe_rtl:label_name(I)), + I1 = hipe_llvm:mk_label(Label), + {I1, Relocs}. + +%% +%% load +%% +trans_load(I, Relocs) -> + RtlDst = hipe_rtl:load_dst(I), + TmpDst = mk_temp(), + %% XXX: Why translate them independently? ------------------------ + {Src, I1} = trans_src(hipe_rtl:load_src(I)), + {Offset, I2} = trans_src(hipe_rtl:load_offset(I)), + T1 = mk_temp(), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + I3 = hipe_llvm:mk_operation(T1, add, WordTy, Src, Offset, []), + %%---------------------------------------------------------------- + I4 = case hipe_rtl:load_size(I) of + word -> + T2 = mk_temp(), + II1 = hipe_llvm:mk_conversion(T2, inttoptr, WordTy, T1, WordTyPtr), + II2 = hipe_llvm:mk_load(TmpDst, WordTyPtr, T2, [], [], false), + [II2, II1]; + Size -> + LoadType = llvm_type_from_size(Size), + LoadTypeP = hipe_llvm:mk_pointer(LoadType), + T2 = mk_temp(), + II1 = hipe_llvm:mk_conversion(T2, inttoptr, WordTy, T1, LoadTypeP), + T3 = mk_temp(), + LoadTypePointer = hipe_llvm:mk_pointer(LoadType), + II2 = hipe_llvm:mk_load(T3, LoadTypePointer, T2, [], [], false), + Conversion = + case hipe_rtl:load_sign(I) of + signed -> sext; + unsigned -> zext + end, + II3 = + hipe_llvm:mk_conversion(TmpDst, Conversion, LoadType, T3, WordTy), + [II3, II2, II1] + end, + I5 = store_stack_dst(TmpDst, RtlDst), + {[I5, I4, I3, I2, I1], Relocs}. + +%% +%% load_address +%% +trans_load_address(I, Relocs) -> + RtlDst = hipe_rtl:load_address_dst(I), + RtlAddr = hipe_rtl:load_address_addr(I), + {Addr, NewRelocs} = + case hipe_rtl:load_address_type(I) of + constant -> + {"%DL" ++ integer_to_list(RtlAddr) ++ "_var", Relocs}; + closure -> + {{_, ClosureName, _}, _, _} = RtlAddr, + FixedClosureName = fix_closure_name(ClosureName), + Relocs1 = relocs_store(FixedClosureName, {closure, RtlAddr}, Relocs), + {"%" ++ FixedClosureName ++ "_var", Relocs1}; + type -> + exit({?MODULE, trans_load_address, + {"Type not implemented in load_address", RtlAddr}}) + end, + I1 = store_stack_dst(Addr, RtlDst), + {[I1], NewRelocs}. + +%% +%% load_atom +%% +trans_load_atom(I, Relocs) -> + RtlDst = hipe_rtl:load_atom_dst(I), + RtlAtom = hipe_rtl:load_atom_atom(I), + AtomName = "atom_" ++ make_llvm_id(atom_to_list(RtlAtom)), + AtomVar = "%" ++ AtomName ++ "_var", + NewRelocs = relocs_store(AtomName, {atom, RtlAtom}, Relocs), + I1 = store_stack_dst(AtomVar, RtlDst), + {[I1], NewRelocs}. + +%% +%% move +%% +trans_move(I, Relocs) -> + RtlDst = hipe_rtl:move_dst(I), + RtlSrc = hipe_rtl:move_src(I), + {Src, I1} = trans_src(RtlSrc), + I2 = store_stack_dst(Src, RtlDst), + {[I2, I1], Relocs}. + +%% +%% return +%% +trans_return(I, Relocs) -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + {VarRet, I1} = + case hipe_rtl:return_varlist(I) of + [] -> + {[], []}; + [A] -> + {Name, II1} = trans_src(A), + {[{WordTy, Name}], II1} + end, + FixedRegs = fixed_registers(), + {LoadedFixedRegs, I2} = load_fixed_regs(FixedRegs), + FixedRet = [{WordTy, X} || X <- LoadedFixedRegs], + Ret = FixedRet ++ VarRet, + {RetTypes, _RetNames} = lists:unzip(Ret), + Type = hipe_llvm:mk_struct(RetTypes), + {RetStruct, I3} = mk_return_struct(Ret, Type), + I4 = hipe_llvm:mk_ret([{Type, RetStruct}]), + {[I4, I3, I2, I1], Relocs}. + +%% @doc Create a structure to hold the return value and the precoloured +%% registers. +mk_return_struct(RetValues, Type) -> + mk_return_struct(RetValues, Type, [], "undef", 0). + +mk_return_struct([], _, Acc, StructName, _) -> + {StructName, Acc}; +mk_return_struct([{ElemType, ElemName}|Rest], Type, Acc, StructName, Index) -> + T1 = mk_temp(), + I1 = hipe_llvm:mk_insertvalue(T1, Type, StructName, ElemType, ElemName, + integer_to_list(Index), []), + mk_return_struct(Rest, Type, [I1 | Acc], T1, Index+1). + +%% +%% store +%% +trans_store(I, Relocs) -> + {Base, I1} = trans_src(hipe_rtl:store_base(I)), + {Offset, I2} = trans_src(hipe_rtl:store_offset(I)), + {Value, I3} = trans_src(hipe_rtl:store_src(I)), + T1 = mk_temp(), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + I4 = hipe_llvm:mk_operation(T1, add, WordTy, Base, Offset, []), + I5 = + case hipe_rtl:store_size(I) of + word -> + T2 = mk_temp(), + II1 = hipe_llvm:mk_conversion(T2, inttoptr, WordTy, T1, WordTyPtr), + II2 = hipe_llvm:mk_store(WordTy, Value, WordTyPtr, T2, [], [], + false), + [II2, II1]; + Size -> + %% XXX: Is always trunc correct ? + LoadType = llvm_type_from_size(Size), + LoadTypePointer = hipe_llvm:mk_pointer(LoadType), + T2 = mk_temp(), + II1 = hipe_llvm:mk_conversion(T2, inttoptr, WordTy, T1, LoadTypePointer), + T3 = mk_temp(), + II2 = hipe_llvm:mk_conversion(T3, 'trunc', WordTy, Value, LoadType), + II3 = hipe_llvm:mk_store(LoadType, T3, LoadTypePointer, T2, [], [], false), + [II3, II2, II1] + end, + {[I5, I4, I3, I2, I1], Relocs}. + +%% +%% switch +%% +trans_switch(I, Relocs, Data) -> + RtlSrc = hipe_rtl:switch_src(I), + {Src, I1} = trans_src(RtlSrc), + Labels = hipe_rtl:switch_labels(I), + JumpLabels = [mk_jump_label(L) || L <- Labels], + SortOrder = hipe_rtl:switch_sort_order(I), + NrLabels = length(Labels), + ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(8)), + TableType = hipe_llvm:mk_array(NrLabels, ByteTyPtr), + TableTypeP = hipe_llvm:mk_pointer(TableType), + TypedJumpLabels = [{hipe_llvm:mk_label_type(), X} || X <- JumpLabels], + T1 = mk_temp(), + {Src2, []} = trans_dst(RtlSrc), + TableName = "table_" ++ tl(Src2), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + I2 = hipe_llvm:mk_getelementptr(T1, TableTypeP, "@"++TableName, + [{WordTy, "0"}, {WordTy, Src}], false), + T2 = mk_temp(), + BYTE_TYPE_PP = hipe_llvm:mk_pointer(ByteTyPtr), + I3 = hipe_llvm:mk_load(T2, BYTE_TYPE_PP, T1, [], [], false), + I4 = hipe_llvm:mk_indirectbr(ByteTyPtr, T2, TypedJumpLabels), + LMap = [{label, L} || L <- Labels], + %% Update data with the info for the jump table + {NewData, JTabLab} = + case hipe_rtl:switch_sort_order(I) of + [] -> + hipe_consttab:insert_block(Data, word, LMap); + SortOrder -> + hipe_consttab:insert_sorted_block(Data, word, LMap, SortOrder) + end, + Relocs2 = relocs_store(TableName, {switch, {TableType, Labels, NrLabels, + SortOrder}, JTabLab}, Relocs), + {[I4, I3, I2, I1], Relocs2, NewData}. + +%% @doc Pass on RTL code in order to fix invoke and closure calls. +fix_code(Code) -> + fix_calls(Code). + +%% @doc Fix invoke calls and closure calls with more than ?NR_ARG_REGS +%% arguments. +fix_calls(Code) -> + fix_calls(Code, [], []). + +fix_calls([], Acc, FailLabels) -> + {lists:reverse(Acc), FailLabels}; +fix_calls([I | Is], Acc, FailLabels) -> + case hipe_rtl:is_call(I) of + true -> + {NewCall, NewFailLabels} = + case hipe_rtl:call_fail(I) of + [] -> + {I, FailLabels}; + FailLabel -> + fix_invoke_call(I, FailLabel, FailLabels) + end, + fix_calls(Is, [NewCall|Acc], NewFailLabels); + false -> + fix_calls(Is, [I|Acc], FailLabels) + end. + +%% @doc When a call has a fail continuation label it must be extended with a +%% normal continuation label to go with the LLVM's invoke instruction. +%% FailLabels is the list of labels of all fail blocks, which are needed to +%% be declared as landing pads. Furtermore, we must add to fail labels a +%% call to hipe_bifs:llvm_fix_pinned_regs/0 in order to avoid reloading old +%% values of pinned registers. This may happen because the result of an +%% invoke instruction is not available at fail-labels, and, thus, we cannot +%% get the correct values of pinned registers. Finally, the stack needs to +%% be re-adjusted when there are stack arguments. +fix_invoke_call(I, FailLabel, FailLabels) -> + NewLabel = hipe_gensym:new_label(llvm), + NewCall1 = hipe_rtl:call_normal_update(I, NewLabel), + SpAdj = find_sp_adj(hipe_rtl:call_arglist(I)), + case lists:keyfind(FailLabel, 1, FailLabels) of + %% Same fail label with same Stack Pointer adjustment + {FailLabel, NewFailLabel, SpAdj} -> + NewCall2 = hipe_rtl:call_fail_update(NewCall1, NewFailLabel), + {NewCall2, FailLabels}; + %% Same fail label but with different Stack Pointer adjustment + {_, _, _} -> + NewFailLabel = hipe_gensym:new_label(llvm), + NewCall2 = hipe_rtl:call_fail_update(NewCall1, NewFailLabel), + {NewCall2, [{FailLabel, NewFailLabel, SpAdj} | FailLabels]}; + %% New Fail label + false -> + NewFailLabel = hipe_gensym:new_label(llvm), + NewCall2 = hipe_rtl:call_fail_update(NewCall1, NewFailLabel), + {NewCall2, [{FailLabel, NewFailLabel, SpAdj} | FailLabels]} + end. + +find_sp_adj(ArgList) -> + NrArgs = length(ArgList), + case NrArgs > ?NR_ARG_REGS of + true -> + (NrArgs - ?NR_ARG_REGS) * hipe_rtl_arch:word_size(); + false -> + 0 + end. + +%% @doc Add landingpad instruction in Fail Blocks. +add_landingpads(LLVM_Code, FailLabels) -> + FailLabels2 = [convert_label(T) || T <- FailLabels], + add_landingpads(LLVM_Code, FailLabels2, []). + +add_landingpads([], _, Acc) -> + lists:reverse(Acc); +add_landingpads([I | Is], FailLabels, Acc) -> + case hipe_llvm:is_label(I) of + true -> + Label = hipe_llvm:label_label(I), + Ins = create_fail_blocks(Label, FailLabels), + add_landingpads(Is, FailLabels, [I | Ins] ++ Acc); + false -> + add_landingpads(Is, FailLabels, [I | Acc]) + end. + +convert_label({X,Y,Z}) -> + {"L" ++ integer_to_list(X), "FL" ++ integer_to_list(Y), Z}. + +%% @doc Create a fail block wich. +create_fail_blocks(_, []) -> []; +create_fail_blocks(Label, FailLabels) -> + create_fail_blocks(Label, FailLabels, []). + +create_fail_blocks(Label, FailLabels, Acc) -> + case lists:keytake(Label, 1, FailLabels) of + false -> + Acc; + {value, {Label, FailLabel, SpAdj}, RestFailLabels} -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + I1 = hipe_llvm:mk_label(FailLabel), + LP = hipe_llvm:mk_landingpad(), + I2 = + case SpAdj > 0 of + true -> + StackPointer = ?ARCH_REGISTERS:reg_name(?ARCH_REGISTERS:sp()), + hipe_llvm:mk_adj_stack(integer_to_list(SpAdj), StackPointer, + WordTy); + false -> [] + end, + T1 = mk_temp(), + FixedRegs = fixed_registers(), + FunRetTy = + hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), + I3 = hipe_llvm:mk_call(T1, false, "cc 11", [], FunRetTy, + "@hipe_bifs.llvm_fix_pinned_regs.0", [], []), + I4 = store_fixed_regs(FixedRegs, T1), + I5 = hipe_llvm:mk_br("%" ++ Label), + Ins = lists:flatten([I5, I4, I3, I2, LP,I1]), + create_fail_blocks(Label, RestFailLabels, Ins ++ Acc) + end. + +%%------------------------------------------------------------------------------ +%% Miscellaneous Functions +%%------------------------------------------------------------------------------ + +%% @doc Convert RTL argument list to LLVM argument list. +trans_args(ArgList) -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + MakeArg = + fun(A) -> + {Name, I1} = trans_src(A), + {{WordTy, Name}, I1} + end, + [MakeArg(A) || A <- ArgList]. + +%% @doc Convert a list of Precoloured registers to LLVM argument list. +fix_reg_args(ArgList) -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + [{WordTy, A} || A <- ArgList]. + +%% @doc Load Precoloured registers. +load_fixed_regs(RegList) -> + Names = [mk_temp_reg(R) || R <- RegList], + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + Fun1 = + fun (X, Y) -> + hipe_llvm:mk_load(X, WordTyPtr, "%" ++ Y ++ "_reg_var", [], [], false) + end, + Ins = lists:zipwith(Fun1, Names, RegList), + {Names, Ins}. + +%% @doc Store Precoloured registers. +store_fixed_regs(RegList, Name) -> + Names = [mk_temp_reg(R) || R <- RegList], + Indexes = lists:seq(0, erlang:length(RegList) - 1), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + FunRetTy = hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), + Fun1 = + fun(X,Y) -> + hipe_llvm:mk_extractvalue(X, FunRetTy, Name, integer_to_list(Y), []) + end, + I1 = lists:zipwith(Fun1, Names, Indexes), + Fun2 = + fun (X, Y) -> + hipe_llvm:mk_store(WordTy, X, WordTyPtr, "%" ++ Y ++ "_reg_var", [], [], + false) + end, + I2 = lists:zipwith(Fun2, Names, RegList), + [I2, I1]. + +%%------------------------------------------------------------------------------ +%% Translation of Names +%%------------------------------------------------------------------------------ + +%% @doc Fix F in MFA tuple to acceptable LLVM identifier (case of closure). +-spec fix_mfa_name(mfa()) -> mfa(). +fix_mfa_name({Mod_Name, Closure_Name, Arity}) -> + Fun_Name = list_to_atom(fix_closure_name(Closure_Name)), + {Mod_Name, Fun_Name, Arity}. + +%% @doc Make an acceptable LLVM identifier for a closure name. +fix_closure_name(ClosureName) -> + make_llvm_id(atom_to_list(ClosureName)). + +%% @doc Create an acceptable LLVM identifier. +make_llvm_id(Name) -> + case Name of + "" -> "Empty"; + Other -> lists:flatten([llvm_id(C) || C <- Other]) + end. + +llvm_id(C) when C=:=46; C>47 andalso C<58; C>64 andalso C<91; C=:=95; + C>96 andalso C<123 -> + C; +llvm_id(C) -> + io_lib:format("_~2.16.0B_",[C]). + +%% @doc Create an acceptable LLVM identifier for an MFA. +trans_mfa_name({M,F,A}) -> + N = atom_to_list(M) ++ "." ++ atom_to_list(F) ++ "." ++ integer_to_list(A), + make_llvm_id(N). + +%%------------------------------------------------------------------------------ +%% Creation of Labels and Temporaries +%%------------------------------------------------------------------------------ +mk_label(N) -> + "L" ++ integer_to_list(N). + +mk_jump_label(N) -> + "%L" ++ integer_to_list(N). + +mk_temp() -> + "%t" ++ integer_to_list(hipe_gensym:new_var(llvm)). + +mk_temp_reg(Name) -> + "%" ++ Name ++ integer_to_list(hipe_gensym:new_var(llvm)). + +%%---------------------------------------------------------------------------- +%% Translation of Operands +%%---------------------------------------------------------------------------- + +store_stack_dst(TempDst, Dst) -> + {Dst2, II1} = trans_dst(Dst), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + II2 = hipe_llvm:mk_store(WordTy, TempDst, WordTyPtr, Dst2, [], [], false), + [II2, II1]. + +store_float_stack(TempDst, Dst) -> + {Dst2, II1} = trans_dst(Dst), + FloatTy = hipe_llvm:mk_double(), + FloatTyPtr = hipe_llvm:mk_pointer(FloatTy), + II2 = hipe_llvm:mk_store(FloatTy, TempDst, FloatTyPtr, Dst2, [], [], false), + [II2, II1]. + +trans_float_src(Src) -> + case hipe_rtl:is_const_label(Src) of + true -> + Name = "@DL" ++ integer_to_list(hipe_rtl:const_label_label(Src)), + T1 = mk_temp(), + %% XXX: Hardcoded offset + ByteTy = hipe_llvm:mk_int(8), + ByteTyPtr = hipe_llvm:mk_pointer(ByteTy), + I1 = hipe_llvm:mk_getelementptr(T1, ByteTyPtr, Name, + [{ByteTy, integer_to_list(?FLOAT_OFFSET)}], true), + T2 = mk_temp(), + FloatTy = hipe_llvm:mk_double(), + FloatTyPtr = hipe_llvm:mk_pointer(FloatTy), + I2 = hipe_llvm:mk_conversion(T2, bitcast, ByteTyPtr, T1, FloatTyPtr), + T3 = mk_temp(), + I3 = hipe_llvm:mk_load(T3, FloatTyPtr, T2, [], [], false), + {T3, [I3, I2, I1]}; + false -> + trans_src(Src) + end. + +trans_src(A) -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + case hipe_rtl:is_imm(A) of + true -> + Value = integer_to_list(hipe_rtl:imm_value(A)), + {Value, []}; + false -> + case hipe_rtl:is_reg(A) of + true -> + case isPrecoloured(A) of + true -> trans_reg(A, src); + false -> + {Name, []} = trans_reg(A, src), + T1 = mk_temp(), + I1 = hipe_llvm:mk_load(T1, WordTyPtr, Name, [], [], false), + {T1, [I1]} + end; + false -> + case hipe_rtl:is_var(A) of + true -> + RootName = "%vr" ++ integer_to_list(hipe_rtl:var_index(A)), + T1 = mk_temp(), + I1 = hipe_llvm:mk_load(T1, WordTyPtr, RootName, [], [], false), + I2 = + case hipe_rtl:var_liveness(A) of + live -> + []; + dead -> + NilValue = hipe_tagscheme:mk_nil(), + hipe_llvm:mk_store(WordTy, integer_to_list(NilValue), WordTyPtr, RootName, + [], [], false) + end, + {T1, [I2, I1]}; + false -> + case hipe_rtl:is_fpreg(A) of + true -> + {Name, []} = trans_dst(A), + T1 = mk_temp(), + FloatTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_double()), + I1 = hipe_llvm:mk_load(T1, FloatTyPtr, Name, [], [], false), + {T1, [I1]}; + false -> trans_dst(A) + end + end + end + end. + +trans_dst(A) -> + case hipe_rtl:is_reg(A) of + true -> + trans_reg(A, dst); + false -> + Name = case hipe_rtl:is_var(A) of + true -> + "%vr" ++ integer_to_list(hipe_rtl:var_index(A)); + false -> + case hipe_rtl:is_fpreg(A) of + true -> "%fr" ++ integer_to_list(hipe_rtl:fpreg_index(A)); + false -> + case hipe_rtl:is_const_label(A) of + true -> + "%DL" ++ integer_to_list(hipe_rtl:const_label_label(A)) ++ "_var"; + false -> + exit({?MODULE, trans_dst, {"Bad RTL argument",A}}) + end + end + end, + {Name, []} + end. + +%% @doc Translate a register. If it is precoloured it must be mapped to the +%% correct stack slot that holds the precoloured register value. +trans_reg(Arg, Position) -> + Index = hipe_rtl:reg_index(Arg), + case isPrecoloured(Arg) of + true -> + Name = map_precoloured_reg(Index), + case Position of + src -> fix_reg_src(Name); + dst -> fix_reg_dst(Name) + end; + false -> + {hipe_rtl_arch:reg_name(Index), []} + end. + +map_precoloured_reg(Index) -> + case hipe_rtl_arch:reg_name(Index) of + "%r15" -> "%hp_reg_var"; + "%rbp" -> "%p_reg_var"; + "%esi" -> "%hp_reg_var"; + "%ebp" -> "%p_reg_var"; + "%fcalls" -> + {"%p_reg_var", ?ARCH_REGISTERS:proc_offset(?ARCH_REGISTERS:fcalls())}; + "%hplim" -> + {"%p_reg_var", ?ARCH_REGISTERS:proc_offset(?ARCH_REGISTERS:heap_limit())}; + _ -> + exit({?MODULE, map_precoloured_reg, {"Register not mapped yet", Index}}) + end. + +%% @doc Load precoloured dst register. +fix_reg_dst(Register) -> + case Register of + {Name, Offset} -> %% Case of %fcalls, %hplim + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + pointer_from_reg(Name, WordTy, Offset); + Name -> %% Case of %p and %hp + {Name, []} + end. + +%% @doc Load precoloured src register. +fix_reg_src(Register) -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + case Register of + {Name, Offset} -> %% Case of %fcalls, %hplim + {T1, I1} = pointer_from_reg(Name, WordTy, Offset), + T2 = mk_temp(), + I2 = hipe_llvm:mk_load(T2, WordTyPtr, T1, [], [] , false), + {T2, [I2, I1]}; + Name -> %% Case of %p and %hp + T1 = mk_temp(), + {T1, hipe_llvm:mk_load(T1, WordTyPtr, Name, [], [], false)} + end. + +%% @doc Load %fcalls and %hplim. +pointer_from_reg(RegName, Type, Offset) -> + PointerType = hipe_llvm:mk_pointer(Type), + T1 = mk_temp(), + I1 = hipe_llvm:mk_load(T1, PointerType, RegName, [], [] ,false), + T2 = mk_temp(), + I2 = hipe_llvm:mk_conversion(T2, inttoptr, Type, T1, PointerType), + T3 = mk_temp(), + %% XXX: Offsets should be a power of 2. + I3 = hipe_llvm:mk_getelementptr(T3, PointerType, T2, + [{Type, integer_to_list(Offset div hipe_rtl_arch:word_size())}], true), + {T3, [I3, I2, I1]}. + +isPrecoloured(X) -> + hipe_rtl_arch:is_precoloured(X). + +%%------------------------------------------------------------------------------ +%% Translation of operators +%%------------------------------------------------------------------------------ + +trans_op(Op) -> + case Op of + add -> add; + sub -> sub; + 'or' -> 'or'; + 'and' -> 'and'; + 'xor' -> 'xor'; + sll -> shl; + srl -> lshr; + sra -> ashr; + mul -> mul; + 'fdiv' -> fdiv; + 'sdiv' -> sdiv; + 'srem' -> srem; + Other -> exit({?MODULE, trans_op, {"Unknown RTL operator", Other}}) + end. + +trans_rel_op(Op) -> + case Op of + eq -> eq; + ne -> ne; + gtu -> ugt; + geu -> uge; + ltu -> ult; + leu -> ule; + gt -> sgt; + ge -> sge; + lt -> slt; + le -> sle + end. + +trans_prim_op(Op) -> + case Op of + '+' -> "bif_add"; + '-' -> "bif_sub"; + '*' -> "bif_mul"; + 'div' -> "bif_div"; + '/' -> "bif_div"; + Other -> atom_to_list(Other) + end. + +trans_fp_op(Op) -> + case Op of + fadd -> fadd; + fsub -> fsub; + fdiv -> fdiv; + fmul -> fmul; + fchs -> fsub; + Other -> exit({?MODULE, trans_fp_op, {"Unknown RTL float operator",Other}}) + end. + +%% Misc. +insn_dst(I) -> + case I of + #alu{} -> + [hipe_rtl:alu_dst(I)]; + #alub{} -> + [hipe_rtl:alub_dst(I)]; + #call{} -> + case hipe_rtl:call_dstlist(I) of + [] -> []; + [Dst] -> [Dst] + end; + #load{} -> + [hipe_rtl:load_dst(I)]; + #load_address{} -> + [hipe_rtl:load_address_dst(I)]; + #load_atom{} -> + [hipe_rtl:load_atom_dst(I)]; + #move{} -> + [hipe_rtl:move_dst(I)]; + #phi{} -> + [hipe_rtl:phi_dst(I)]; + #fconv{} -> + [hipe_rtl:fconv_dst(I)]; + #fload{} -> + [hipe_rtl:fload_dst(I)]; + #fmove{} -> + [hipe_rtl:fmove_dst(I)]; + #fp{} -> + [hipe_rtl:fp_dst(I)]; + #fp_unop{} -> + [hipe_rtl:fp_unop_dst(I)]; + _ -> + [] + end. + +llvm_type_from_size(Size) -> + case Size of + byte -> hipe_llvm:mk_int(8); + int16 -> hipe_llvm:mk_int(16); + int32 -> hipe_llvm:mk_int(32); + word -> hipe_llvm:mk_int(64) + end. + +%% @doc Create definition for the compiled function. The parameters that are +%% passed to the stack must be reversed to match with the CC. Also +%% precoloured registers that are passed as arguments must be stored to +%% the corresonding stack slots. +create_function_definition(Fun, Params, Code, LocalVars) -> + FunctionName = trans_mfa_name(Fun), + FixedRegs = fixed_registers(), + %% Reverse parameters to match with the Erlang calling convention + ReversedParams = + case erlang:length(Params) > ?NR_ARG_REGS of + false -> + Params; + true -> + {ParamsInRegs, ParamsInStack} = lists:split(?NR_ARG_REGS, Params), + ParamsInRegs ++ lists:reverse(ParamsInStack) + end, + Args = header_regs(FixedRegs) ++ header_params(ReversedParams), + EntryLabel = hipe_llvm:mk_label("Entry"), + FloatTy = hipe_llvm:mk_double(), + ExceptionSync = hipe_llvm:mk_alloca("%exception_sync", FloatTy, [], []), + I2 = load_regs(FixedRegs), + I3 = hipe_llvm:mk_br(mk_jump_label(get(first_label))), + StoredParams = store_params(Params), + EntryBlock = + lists:flatten([EntryLabel, ExceptionSync, I2, LocalVars, StoredParams, I3]), + Final_Code = EntryBlock ++ Code, + FunctionOptions = [nounwind, noredzone, list_to_atom("gc \"erlang\"")], + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + FunRetTy = hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), + hipe_llvm:mk_fun_def([], [], "cc 11", [], FunRetTy, FunctionName, Args, + FunctionOptions, [], Final_Code). + +header_params(Params) -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + [{WordTy, "%v" ++ integer_to_list(hipe_rtl:var_index(P))} || P <- Params]. + +store_params(Params) -> + Fun1 = + fun(X) -> + Index = hipe_rtl:var_index(X), + {Name, _} = trans_dst(X), + ParamName = "%v" ++ integer_to_list(Index), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + hipe_llvm:mk_store(WordTy, ParamName, WordTyPtr, Name, [], [], false) + end, + lists:map(Fun1, Params). + +fixed_registers() -> + case get(hipe_target_arch) of + x86 -> + ["hp", "p"]; + amd64 -> + ["hp", "p"]; + Other -> + exit({?MODULE, map_registers, {"Unknown architecture", Other}}) + end. + +header_regs(Registers) -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + [{WordTy, "%" ++ X ++ "_in"} || X <- Registers]. + +load_regs(Registers) -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + Fun1 = + fun(X) -> + I1 = hipe_llvm:mk_alloca("%" ++ X ++ "_reg_var", WordTy, [], []), + I2 = hipe_llvm:mk_store(WordTy, "%" ++ X ++ "_in", WordTyPtr, + "%" ++ X ++ "_reg_var", [], [], false), + [I1, I2] + end, + lists:map(Fun1, Registers). + +%%------------------------------------------------------------------------------ +%% Relocation-specific Stuff +%%------------------------------------------------------------------------------ + +relocs_store(Key, Value, Relocs) -> + dict:store(Key, Value, Relocs). + +relocs_to_list(Relocs) -> + dict:to_list(Relocs). + +%% @doc This function is responsible for the actions needed to handle +%% relocations: +%% 1) Updates relocations with constants and switch jump tables. +%% 2) Creates LLVM code to declare relocations as external +%% functions/constants. +%% 3) Creates LLVM code in order to create local variables for the external +%% constants/labels. +handle_relocations(Relocs, Data, Fun) -> + RelocsList = relocs_to_list(Relocs), + %% Seperate Relocations according to their type + {CallList, AtomList, ClosureList, ClosureLabels, SwitchList} = + seperate_relocs(RelocsList), + %% Create code to declare atoms + AtomDecl = [declare_atom(A) || A <- AtomList], + %% Create code to create local name for atoms + AtomLoad = [load_atom(A) || A <- AtomList], + %% Create code to declare closures + ClosureDecl = [declare_closure(C) || C <- ClosureList], + %% Create code to create local name for closures + ClosureLoad = [load_closure(C) || C <- ClosureList], + %% Find function calls + IsExternalCall = fun (X) -> is_external_call(X, Fun) end, + ExternalCallList = lists:filter(IsExternalCall, CallList), + %% Create code to declare external function + FunDecl = fixed_fun_decl() ++ [call_to_decl(C) || C <- ExternalCallList], + %% Extract constant labels from Constant Map (remove duplicates) + ConstLabels = hipe_consttab:labels(Data), + %% Create code to declare constants + ConstDecl = [declare_constant(C) || C <- ConstLabels], + %% Create code to create local name for constants + ConstLoad = [load_constant(C) || C <- ConstLabels], + %% Create code to create jump tables + SwitchDecl = declare_switches(SwitchList, Fun), + %% Create code to create a table with the labels of all closure calls + {ClosureLabelDecl, Relocs1} = + declare_closure_labels(ClosureLabels, Relocs, Fun), + %% Enter constants to relocations + Relocs2 = lists:foldl(fun const_to_dict/2, Relocs1, ConstLabels), + %% Temporary Store inc_stack and llvm_fix_pinned_regs to Dictionary + %% TODO: Remove this + Relocs3 = dict:store("inc_stack_0", {call, {bif, inc_stack_0, 0}}, Relocs2), + Relocs4 = dict:store("hipe_bifs.llvm_fix_pinned_regs.0", + {call, {hipe_bifs, llvm_fix_pinned_regs, 0}}, Relocs3), + BranchMetaData = [ + hipe_llvm:mk_meta(?BRANCH_META_TAKEN, ["branch_weights", 99, 1]) + , hipe_llvm:mk_meta(?BRANCH_META_NOT_TAKEN, ["branch_weights", 1, 99]) + ], + ExternalDeclarations = AtomDecl ++ ClosureDecl ++ ConstDecl ++ FunDecl ++ + ClosureLabelDecl ++ SwitchDecl ++ BranchMetaData, + LocalVariables = AtomLoad ++ ClosureLoad ++ ConstLoad, + {Relocs4, ExternalDeclarations, LocalVariables}. + +%% @doc Seperate relocations according to their type. +seperate_relocs(Relocs) -> + seperate_relocs(Relocs, [], [], [], [], []). + +seperate_relocs([], CallAcc, AtomAcc, ClosureAcc, LabelAcc, JmpTableAcc) -> + {CallAcc, AtomAcc, ClosureAcc, LabelAcc, JmpTableAcc}; +seperate_relocs([R|Rs], CallAcc, AtomAcc, ClosureAcc, LabelAcc, JmpTableAcc) -> + case R of + {_, {call, _}} -> + seperate_relocs(Rs, [R | CallAcc], AtomAcc, ClosureAcc, LabelAcc, + JmpTableAcc); + {_, {atom, _}} -> + seperate_relocs(Rs, CallAcc, [R | AtomAcc], ClosureAcc, LabelAcc, + JmpTableAcc); + {_, {closure, _}} -> + seperate_relocs(Rs, CallAcc, AtomAcc, [R | ClosureAcc], LabelAcc, + JmpTableAcc); + {_, {switch, _, _}} -> + seperate_relocs(Rs, CallAcc, AtomAcc, ClosureAcc, LabelAcc, + [R | JmpTableAcc]); + {_, {closure_label, _, _}} -> + seperate_relocs(Rs, CallAcc, AtomAcc, ClosureAcc, [R | LabelAcc], + JmpTableAcc) + end. + +%% @doc External declaration of an atom. +declare_atom({AtomName, _}) -> + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + hipe_llvm:mk_const_decl("@" ++ AtomName, "external constant", WordTy, ""). + +%% @doc Creation of local variable for an atom. +load_atom({AtomName, _}) -> + Dst = "%" ++ AtomName ++ "_var", + Name = "@" ++ AtomName, + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + WordTyPtr = hipe_llvm:mk_pointer(WordTy), + hipe_llvm:mk_conversion(Dst, ptrtoint, WordTyPtr, Name, WordTy). + +%% @doc External declaration of a closure. +declare_closure({ClosureName, _})-> + ByteTy = hipe_llvm:mk_int(8), + hipe_llvm:mk_const_decl("@" ++ ClosureName, "external constant", ByteTy, ""). + +%% @doc Creation of local variable for a closure. +load_closure({ClosureName, _})-> + Dst = "%" ++ ClosureName ++ "_var", + Name = "@" ++ ClosureName, + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(8)), + hipe_llvm:mk_conversion(Dst, ptrtoint, ByteTyPtr, Name, WordTy). + +%% @doc Declaration of a local variable for a switch jump table. +declare_switches(JumpTableList, Fun) -> + FunName = trans_mfa_name(Fun), + [declare_switch_table(X, FunName) || X <- JumpTableList]. + +declare_switch_table({Name, {switch, {TableType, Labels, _, _}, _}}, FunName) -> + LabelList = [mk_jump_label(L) || L <- Labels], + Fun1 = fun(X) -> "i8* blockaddress(@" ++ FunName ++ ", " ++ X ++ ")" end, + List2 = lists:map(Fun1, LabelList), + List3 = string:join(List2, ",\n"), + List4 = "[\n" ++ List3 ++ "\n]\n", + hipe_llvm:mk_const_decl("@" ++ Name, "constant", TableType, List4). + +%% @doc Declaration of a variable for a table with the labels of all closure +%% calls in the code. +declare_closure_labels([], Relocs, _Fun) -> + {[], Relocs}; +declare_closure_labels(ClosureLabels, Relocs, Fun) -> + FunName = trans_mfa_name(Fun), + {LabelList, ArityList} = + lists:unzip([{mk_jump_label(Label), A} || + {_, {closure_label, Label, A}} <- ClosureLabels]), + Relocs1 = relocs_store("table_closures", {table_closures, ArityList}, Relocs), + List2 = + ["i8* blockaddress(@" ++ FunName ++ ", " ++ L ++ ")" || L <- LabelList], + List3 = string:join(List2, ",\n"), + List4 = "[\n" ++ List3 ++ "\n]\n", + NrLabels = length(LabelList), + ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(8)), + TableType = hipe_llvm:mk_array(NrLabels, ByteTyPtr), + ConstDecl = + hipe_llvm:mk_const_decl("@table_closures", "constant", TableType, List4), + {[ConstDecl], Relocs1}. + +%% @doc A call is treated as non external only in a case of a recursive +%% function. +is_external_call({_, {call, Fun}}, Fun) -> false; +is_external_call(_, _) -> true. + +%% @doc External declaration of a function. +call_to_decl({Name, {call, MFA}}) -> + {M, _F, A} = MFA, + CConv = "cc 11", + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + FunRetTy = hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), + {Type, Args} = + case M of + llvm -> + {hipe_llvm:mk_struct([WordTy, hipe_llvm:mk_int(1)]), [1, 2]}; + %% +precoloured regs + _ -> + {FunRetTy, lists:seq(1, A + ?NR_PINNED_REGS)} + end, + ArgsTypes = lists:duplicate(length(Args), WordTy), + hipe_llvm:mk_fun_decl([], [], CConv, [], Type, "@" ++ Name, ArgsTypes, []). + +%% @doc These functions are always declared, even if not used. +fixed_fun_decl() -> + ByteTy = hipe_llvm:mk_int(8), + ByteTyPtr = hipe_llvm:mk_pointer(ByteTy), + LandPad = hipe_llvm:mk_fun_decl([], [], [], [], hipe_llvm:mk_int(32), + "@__gcc_personality_v0", [hipe_llvm:mk_int(32), hipe_llvm:mk_int(64), + ByteTyPtr, ByteTyPtr], []), + GCROOTDecl = hipe_llvm:mk_fun_decl([], [], [], [], hipe_llvm:mk_void(), + "@llvm.gcroot", [hipe_llvm:mk_pointer(ByteTyPtr), ByteTyPtr], []), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + FunRetTy = hipe_llvm:mk_struct(lists:duplicate(?NR_PINNED_REGS + 1, WordTy)), + FixPinnedRegs = hipe_llvm:mk_fun_decl([], [], [], [], FunRetTy, + "@hipe_bifs.llvm_fix_pinned_regs.0", [], []), + GcMetadata = hipe_llvm:mk_const_decl("@gc_metadata", "external constant", + ByteTy, ""), + [LandPad, GCROOTDecl, FixPinnedRegs, GcMetadata]. + +%% @doc Declare an External Consant. We declare all constants as i8 in order to +%% be able to calcucate pointers of the form DL+6, with the getelementptr +%% instruction. Otherwise we have to convert constants form pointers to +%% values, add the offset and convert them again to pointers. +declare_constant(Label) -> + Name = "@DL" ++ integer_to_list(Label), + ByteTy = hipe_llvm:mk_int(8), + hipe_llvm:mk_const_decl(Name, "external constant", ByteTy, ""). + +%% @doc Load a constant is achieved by converting a pointer to an integer of +%% the correct width. +load_constant(Label) -> + Dst = "%DL" ++ integer_to_list(Label) ++ "_var", + Name = "@DL" ++ integer_to_list(Label), + WordTy = hipe_llvm:mk_int(?WORD_WIDTH), + ByteTyPtr = hipe_llvm:mk_pointer(hipe_llvm:mk_int(8)), + hipe_llvm:mk_conversion(Dst, ptrtoint, ByteTyPtr, Name, WordTy). + +%% @doc Store external constants and calls to dictionary. +const_to_dict(Elem, Dict) -> + Name = "DL" ++ integer_to_list(Elem), + dict:store(Name, {'constant', Elem}, Dict). + +%% @doc Export the hipe literals that LLVM needs to generate the prologue as +%% metadata. +add_literals_metadata(ExternalDecls) -> + Pairs = [hipe_llvm:mk_meta(integer_to_list(?FIRST_FREE_META_NO), + ["P_NSP_LIMIT", ?P_NSP_LIMIT]) + ,hipe_llvm:mk_meta(integer_to_list(?FIRST_FREE_META_NO + 1), + ["X86_LEAF_WORDS", ?X86_LEAF_WORDS]) + ,hipe_llvm:mk_meta(integer_to_list(?FIRST_FREE_META_NO + 2), + ["AMD64_LEAF_WORDS", ?AMD64_LEAF_WORDS]) + ], + [hipe_llvm:mk_meta(?HIPE_LITERALS_META, Pairs) | + Pairs ++ ExternalDecls]. diff --git a/lib/hipe/main/Makefile b/lib/hipe/main/Makefile index 66e4c3e39a..8ef31dbb46 100644 --- a/lib/hipe/main/Makefile +++ b/lib/hipe/main/Makefile @@ -1,18 +1,19 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2001-2012. All Rights Reserved. +# Copyright Ericsson AB 2001-2016. All Rights Reserved. # -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at # -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. # # %CopyrightEnd% # @@ -69,7 +70,7 @@ APPUP_TARGET= $(EBIN)/$(APPUP_FILE) include ../native.mk -ERL_COMPILE_FLAGS += +nowarn_shadow_vars +warn_missing_spec +warn_untyped_record +ERL_COMPILE_FLAGS += -Werror +nowarn_shadow_vars +warn_export_vars +warn_missing_spec +warn_untyped_record # ---------------------------------------------------- # Targets diff --git a/lib/hipe/main/hipe.app.src b/lib/hipe/main/hipe.app.src index 7db4db8a57..f8487151d7 100644 --- a/lib/hipe/main/hipe.app.src +++ b/lib/hipe/main/hipe.app.src @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2012. All Rights Reserved. +%% Copyright Ericsson AB 2002-2015. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -30,6 +31,7 @@ cerl_prettypr, cerl_to_icode, cerl_typean, + elf_format, erl_bif_types, erl_types, hipe, @@ -86,6 +88,7 @@ hipe_icode2rtl, hipe_icode_bincomp, hipe_icode_callgraph, + hipe_icode_call_elim, hipe_icode_cfg, hipe_icode_coordinator, hipe_icode_ebb, @@ -108,6 +111,10 @@ hipe_ig, hipe_ig_moves, hipe_jit, + hipe_llvm, + hipe_llvm_liveness, + hipe_llvm_main, + hipe_llvm_merge, hipe_ls_regalloc, hipe_main, hipe_moves, @@ -159,6 +166,7 @@ hipe_rtl_symbolic, hipe_rtl_to_amd64, hipe_rtl_to_arm, + hipe_rtl_to_llvm, hipe_rtl_to_ppc, hipe_rtl_to_sparc, hipe_rtl_to_x86, @@ -192,7 +200,6 @@ hipe_tagscheme, hipe_temp_map, hipe_timing, - hipe_tool, hipe_vectors, hipe_x86, hipe_x86_assemble, @@ -217,4 +224,6 @@ hipe_x86_x87]}, {registered,[]}, {applications, [kernel,stdlib]}, - {env, []}]}. + {env, []}, + {runtime_dependencies, ["syntax_tools-1.6.14","stdlib-2.5","kernel-3.0", + "erts-7.1","compiler-5.0"]}]}. diff --git a/lib/hipe/main/hipe.appup.src b/lib/hipe/main/hipe.appup.src index 1d5a0d93f5..b297ba10db 100644 --- a/lib/hipe/main/hipe.appup.src +++ b/lib/hipe/main/hipe.appup.src @@ -1,19 +1,19 @@ -%% +%% -*- erlang -*- %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2009. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. +%% Copyright Ericsson AB 2002-2016. All Rights Reserved. %% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% -%% -{"%VSN%",[],[]}. +{"%VSN%", [], []}. diff --git a/lib/hipe/main/hipe.erl b/lib/hipe/main/hipe.erl index 434d5c3061..6c525dd143 100644 --- a/lib/hipe/main/hipe.erl +++ b/lib/hipe/main/hipe.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% Copyright Ericsson AB 2001-2015. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -199,14 +200,17 @@ compile/4, compile_core/4, file/1, - file/2, + file/2, + get_llvm_version/0, + llvm_support_available/0, load/1, help/0, help_hiper/0, help_options/0, help_option/1, help_debug_options/0, - version/0]). + version/0, + erts_checksum/0]). -ifndef(DEBUG). -define(DEBUG,true). @@ -214,6 +218,7 @@ -include("hipe.hrl"). -include("../../compiler/src/beam_disasm.hrl"). +-include("../rtl/hipe_literals.hrl"). %%------------------------------------------------------------------- %% Basic type declaration for exported functions of the 'hipe' module @@ -444,16 +449,16 @@ compile(Name, File, Opts0) when is_atom(Name) -> true -> case filename:find_src(filename:rootname(File, ".beam")) of {error, _} -> - ?error_msg("Cannot find source code for ~p.",[File]), + ?error_msg("Cannot find source code for ~p.", [File]), ?EXIT({cant_find_source_code}); {Source, CompOpts} -> CoreOpts = [X || X = {core_transform, _} <- Opts], - %%io:format("Using: ~w\n", [CoreOpts]), + %% io:format("Using: ~w\n", [CoreOpts]), case compile:file(Source, CoreOpts ++ [to_core, binary|CompOpts]) of {ok, _, Core} -> compile_core(Name, Core, File, Opts); Error -> - ?error_msg("Error compiling ~p:\n~p.",[File, Error]), + ?error_msg("Error compiling ~p:\n~p.", [File, Error]), ?EXIT({cant_compile_source_code}) end end; @@ -465,7 +470,7 @@ compile(Name, File, Opts0) when is_atom(Name) -> {ok, _, Core} -> compile_core(Name, Core, File, Opts); Error -> - ?error_msg("Error compiling ~p:\n~p\n",[Source, Error]), + ?error_msg("Error compiling ~p:\n~p\n", [Source, Error]), ?EXIT({cant_compile_source_code, Error}) end; Other when Other =:= false; Other =:= undefined -> @@ -568,8 +573,7 @@ file(File, Options) when is_atom(File) -> disasm(File) -> case beam_disasm:file(File) of #beam_file{labeled_exports = LabeledExports, - compile_info = CompInfo, - code = BeamCode} -> + compile_info = CompInfo, code = BeamCode} -> CompOpts = proplists:get_value(options, CompInfo, []), HCompOpts = case lists:keyfind(hipe, 1, CompOpts) of {hipe, L} when is_list(L) -> L; @@ -592,16 +596,16 @@ fix_beam_exports([], Exports) -> Exports. get_beam_icode(Mod, {BeamCode, Exports}, File, Options) -> - ?option_time({ok, Icode} = - (catch {ok, hipe_beam_to_icode:module(BeamCode, Options)}), - "BEAM-to-Icode", Options), + {ok, Icode} = + ?option_time((catch {ok, hipe_beam_to_icode:module(BeamCode, Options)}), + "BEAM-to-Icode", Options), BeamBin = get_beam_code(File), {{Mod, Exports, Icode}, BeamBin}. get_core_icode(Mod, Core, File, Options) -> - ?option_time({ok, Icode} = - (catch {ok, cerl_to_icode:module(Core, Options)}), - "BEAM-to-Icode", Options), + {ok, Icode} = + ?option_time((catch {ok, cerl_to_icode:module(Core, Options)}), + "BEAM-to-Icode", Options), NeedBeamCode = not proplists:get_bool(load, Options), BeamBin = case NeedBeamCode of @@ -614,7 +618,7 @@ get_core_icode(Mod, Core, File, Options) -> get_beam_code(Bin) when is_binary(Bin) -> Bin; get_beam_code(FileName) -> case erl_prim_loader:get_file(FileName) of - {ok,Bin,_} -> + {ok, Bin, _} -> Bin; error -> ?EXIT(no_beam_file) @@ -648,7 +652,19 @@ run_compiler_1(DisasmFun, IcodeFun, Options) -> %% The full option expansion is not done %% until the DisasmFun returns. {Code, CompOpts} = DisasmFun(Options), - Opts = expand_options(Options ++ CompOpts), + Opts0 = expand_options(Options ++ CompOpts, + get(hipe_target_arch)), + Opts = + case proplists:get_bool(to_llvm, Opts0) andalso + not llvm_support_available() of + true -> + ?error_msg("No LLVM version 3.4 or greater " + "found in $PATH; aborting " + "native code compilation.\n", []), + ?EXIT(cant_find_required_llvm_version); + false -> + Opts0 + end, check_options(Opts), ?when_option(verbose, Options, ?debug_msg("Options: ~p.\n",[Opts])), @@ -748,7 +764,8 @@ finalize(OrigList, Mod, Exports, WholeModule, Opts) -> finalize_fun(MfaIcodeList, Exports, Opts) -> case proplists:get_value(concurrent_comp, Opts) of FalseVal when (FalseVal =:= undefined) orelse (FalseVal =:= false) -> - [finalize_fun_sequential(MFAIcode, Opts, #comp_servers{}) + NoServers = #comp_servers{pp_server = none, range = none, type = none}, + [finalize_fun_sequential(MFAIcode, Opts, NoServers) || {_MFA, _Icode} = MFAIcode <- MfaIcodeList]; TrueVal when (TrueVal =:= true) orelse (TrueVal =:= debug) -> finalize_fun_concurrent(MfaIcodeList, Exports, Opts) @@ -821,7 +838,9 @@ finalize_fun_sequential({MFA, Icode}, Opts, Servers) -> ?debug_msg("Compiled ~w in ~.2f s\n", [MFA,(T2-T1)/1000])), {MFA, Code}; {rtl, LinearRtl} -> - {MFA, LinearRtl} + {MFA, LinearRtl}; + {llvm_binary, Binary} -> + {MFA, Binary} catch error:Error -> ?when_option(verbose, Opts, ?debug_untagged_msg("\n", [])), @@ -881,8 +900,7 @@ do_load(Mod, Bin, BeamBinOrPath) when is_binary(BeamBinOrPath); code:load_native_sticky(Mod, Bin, Beam); false -> %% Normal loading of a whole module - Architecture = erlang:system_info(hipe_architecture), - ChunkName = hipe_unified_loader:chunk_name(Architecture), + ChunkName = hipe_unified_loader:chunk_name(HostArch), {ok, _, Chunks0} = beam_lib:all_chunks(BeamBinOrPath), Chunks = [{ChunkName, Bin}|lists:keydelete(ChunkName, 1, Chunks0)], {ok, BeamPlusNative} = beam_lib:build_module(Chunks), @@ -890,21 +908,27 @@ do_load(Mod, Bin, BeamBinOrPath) when is_binary(BeamBinOrPath); end. assemble(CompiledCode, Closures, Exports, Options) -> - case get(hipe_target_arch) of - ultrasparc -> - hipe_sparc_assemble:assemble(CompiledCode, Closures, Exports, Options); - powerpc -> - hipe_ppc_assemble:assemble(CompiledCode, Closures, Exports, Options); - ppc64 -> - hipe_ppc_assemble:assemble(CompiledCode, Closures, Exports, Options); - arm -> - hipe_arm_assemble:assemble(CompiledCode, Closures, Exports, Options); - x86 -> - hipe_x86_assemble:assemble(CompiledCode, Closures, Exports, Options); - amd64 -> - hipe_amd64_assemble:assemble(CompiledCode, Closures, Exports, Options); - Arch -> - ?EXIT({executing_on_an_unsupported_architecture, Arch}) + case proplists:get_bool(to_llvm, Options) of + false -> + case get(hipe_target_arch) of + ultrasparc -> + hipe_sparc_assemble:assemble(CompiledCode, Closures, Exports, Options); + powerpc -> + hipe_ppc_assemble:assemble(CompiledCode, Closures, Exports, Options); + ppc64 -> + hipe_ppc_assemble:assemble(CompiledCode, Closures, Exports, Options); + arm -> + hipe_arm_assemble:assemble(CompiledCode, Closures, Exports, Options); + x86 -> + hipe_x86_assemble:assemble(CompiledCode, Closures, Exports, Options); + amd64 -> + hipe_amd64_assemble:assemble(CompiledCode, Closures, Exports, Options); + Arch -> + ?EXIT({executing_on_an_unsupported_architecture, Arch}) + end; + true -> + %% Merge already compiled code (per MFA) to a single binary. + hipe_llvm_merge:finalize(CompiledCode, Closures, Exports) end. %% -------------------------------------------------------------------- @@ -913,9 +937,9 @@ assemble(CompiledCode, Closures, Exports, Options) -> %% but can be overridden by passing an option {target, Target}. set_architecture(Options) -> - put(hipe_host_arch, erlang:system_info(hipe_architecture)), - put(hipe_target_arch, - proplists:get_value(target, Options, get(hipe_host_arch))), + HostArch = erlang:system_info(hipe_architecture), + put(hipe_host_arch, HostArch), + put(hipe_target_arch, proplists:get_value(target, Options, HostArch)), ok. %% This sets up some globally accessed stuff that are needed by the @@ -923,7 +947,7 @@ set_architecture(Options) -> %% Therefore, this expands the current set of options for local use. pre_init(Opts) -> - Options = expand_options(Opts), + Options = expand_options(Opts, get(hipe_target_arch)), %% Initialise some counters used for measurements and benchmarking. If %% the option 'measure_regalloc' is given the compilation will return %% a keylist with the counter values. @@ -1011,6 +1035,12 @@ post(Res, Icode, Options) -> version() -> ?VERSION_STRING(). +%% @doc Returns checksum identifying the target runtime system. +-spec erts_checksum() -> integer(). + +erts_checksum() -> + ?HIPE_ERTS_CHECKSUM. + %% -------------------------------------------------------------------- %% D O C U M E N T A T I O N - H E L P %% -------------------------------------------------------------------- @@ -1041,6 +1071,8 @@ help() -> " Prints a description of debug options.\n" ++ " version() ->\n" ++ " Returns the HiPE version as a string'.\n" ++ + " erts_checksum() ->\n" ++ + " Returns a checksum identifying the target runtime system.\n" ++ "\n" ++ " For HiPE developers only:\n" ++ " Use `help_hiper()' for information about HiPE's low-level interface\n", @@ -1085,10 +1117,10 @@ help_hiper() -> -spec help_options() -> 'ok'. help_options() -> - set_architecture([]), %% needed for target-specific option expansion - O1 = expand_options([o1]), - O2 = expand_options([o2]), - O3 = expand_options([o3]), + HostArch = erlang:system_info(hipe_architecture), + O1 = expand_options([o1], HostArch), + O2 = expand_options([o2], HostArch), + O3 = expand_options([o3], HostArch), io:format("HiPE Compiler Options\n" ++ " Boolean-valued options generally have corresponding " ++ "aliases `no_...',\n" ++ @@ -1114,7 +1146,7 @@ help_options() -> [ordsets:from_list([verbose, debug, time, load, pp_beam, pp_icode, pp_rtl, pp_native, pp_asm, timeout]), - expand_options([pp_all]), + expand_options([pp_all], HostArch), O1 -- [o1], (O2 -- O1) -- [o2], (O3 -- O2) -- [o3]]), @@ -1133,6 +1165,9 @@ option_text(caller_save_spill_restore) -> "Activates caller save register spills and restores"; option_text(debug) -> "Outputs internal debugging information during compilation"; +option_text(icode_call_elim) -> + "Performs call elimination of BIFs that are side-effect free\n" ++ + "only on some argument types"; option_text(icode_range) -> "Performs integer range analysis on the Icode level"; option_text(icode_ssa_check) -> @@ -1212,8 +1247,8 @@ option_text(Opt) when is_atom(Opt) -> -spec help_option(comp_option()) -> 'ok'. help_option(Opt) -> - set_architecture([]), %% needed for target-specific option expansion - case expand_options([Opt]) of + HostArch = erlang:system_info(hipe_architecture), + case expand_options([Opt], HostArch) of [Opt] -> Name = if is_atom(Opt) -> Opt; tuple_size(Opt) =:= 2 -> element(1, Opt) @@ -1286,6 +1321,7 @@ opt_keys() -> get_called_modules, split_arith, split_arith_unsafe, + icode_call_elim, icode_inline_bifs, icode_ssa_check, icode_ssa_copy_prop, @@ -1330,6 +1366,11 @@ opt_keys() -> timeregalloc, timers, to_rtl, + to_llvm, % Use the LLVM backend for compilation. + llvm_save_temps, % Save the LLVM intermediate files in the current + % directory; useful for debugging. + llvm_llc, % Specify llc optimization-level: o1, o2, o3, undefined. + llvm_opt, % Specify opt optimization-level: o1, o2, o3, undefined. use_indexing, use_inline_atom_search, use_callgraph, @@ -1339,11 +1380,11 @@ opt_keys() -> %% verbose_spills, x87]. -%% Definitions: +%% Definitions: -o1_opts() -> +o1_opts(TargetArch) -> Common = [inline_fp, pmatch, peephole], - case get(hipe_target_arch) of + case TargetArch of ultrasparc -> Common; powerpc -> @@ -1360,48 +1401,22 @@ o1_opts() -> ?EXIT({executing_on_an_unsupported_architecture,Arch}) end. -o2_opts() -> +o2_opts(TargetArch) -> Common = [icode_ssa_const_prop, icode_ssa_copy_prop, % icode_ssa_struct_reuse, - icode_type, icode_inline_bifs, rtl_lcm, + icode_type, icode_inline_bifs, icode_call_elim, rtl_lcm, rtl_ssa, rtl_ssa_const_prop, - spillmin_color, use_indexing, remove_comments, - concurrent_comp, binary_opt | o1_opts()], - case get(hipe_target_arch) of - ultrasparc -> - Common; - powerpc -> - Common; - ppc64 -> - Common; - arm -> - Common; - x86 -> - Common; - % [rtl_ssapre | Common]; - amd64 -> - [icode_range | Common]; % range analysis is effective on 64 bits - Arch -> - ?EXIT({executing_on_an_unsupported_architecture,Arch}) - end. - -o3_opts() -> - Common = [icode_range, {regalloc,coalescing} | o2_opts()], - case get(hipe_target_arch) of - ultrasparc -> - Common; - powerpc -> - Common; - ppc64 -> - Common; - arm -> - Common; - x86 -> - Common; - amd64 -> - Common; - Arch -> - ?EXIT({executing_on_an_unsupported_architecture,Arch}) - end. + spillmin_color, use_indexing, remove_comments, + concurrent_comp, binary_opt | o1_opts(TargetArch)], + case TargetArch of + T when T =:= amd64 orelse T =:= ppc64 -> % 64-bit targets + [icode_range | Common]; + _ -> % T \in [arm, powerpc, ultrasparc, x86] + Common % [rtl_ssapre | Common]; + end. + +o3_opts(TargetArch) -> + %% no point checking for target architecture since this is checked in 'o1' + [icode_range, {regalloc,coalescing} | o2_opts(TargetArch)]. %% Note that in general, the normal form for options should be positive. %% This is a good programming convention, so that tests in the code say @@ -1418,6 +1433,7 @@ opt_negations() -> {no_icode_inline_bifs, icode_inline_bifs}, {no_icode_range, icode_range}, {no_icode_split_arith, icode_split_arith}, + {no_icode_call_elim, icode_call_elim}, {no_icode_ssa_check, icode_ssa_check}, {no_icode_ssa_copy_prop, icode_ssa_copy_prop}, {no_icode_ssa_const_prop, icode_ssa_const_prop}, @@ -1464,15 +1480,30 @@ opt_aliases() -> opt_basic_expansions() -> [{pp_all, [pp_beam, pp_icode, pp_rtl, pp_native]}]. -opt_expansions() -> - [{o1, o1_opts()}, - {o2, o2_opts()}, - {o3, o3_opts()}, +opt_expansions(TargetArch) -> + [{o1, o1_opts(TargetArch)}, + {o2, o2_opts(TargetArch)}, + {o3, o3_opts(TargetArch)}, + {to_llvm, llvm_opts(o3, TargetArch)}, + {{to_llvm, o0}, llvm_opts(o0, TargetArch)}, + {{to_llvm, o1}, llvm_opts(o1, TargetArch)}, + {{to_llvm, o2}, llvm_opts(o2, TargetArch)}, + {{to_llvm, o3}, llvm_opts(o3, TargetArch)}, {x87, [x87, inline_fp]}, - {inline_fp, case get(hipe_target_arch) of %% XXX: Temporary until x86 - x86 -> [x87, inline_fp]; %% has sse2 + {inline_fp, case TargetArch of %% XXX: Temporary until x86 has sse2 + x86 -> [x87, inline_fp]; _ -> [inline_fp] end}]. +llvm_opts(O, TargetArch) -> + Base = [to_llvm, {llvm_opt, O}, {llvm_llc, O}], + case TargetArch of + %% A llvm bug present in 3.4 through (at least) 3.8 miscompiles x86 + %% functions that have floats are spilled to stack by clobbering the process + %% pointer (ebp) trying to realign the stack pointer. + x86 -> [no_inline_fp | Base]; + _ -> Base + end. + %% This expands "basic" options, which may be tested early and cannot be %% in conflict with options found in the source code. @@ -1490,18 +1521,19 @@ expand_kt2(Opts) -> [{use_callgraph, fixpoint}, core, {core_transform, cerl_typean}]}]}]). -%% Note that set_architecture/1 must be called first, and that the given +%% Note that the given %% list should contain the total set of options, since things like 'o2' %% are expanded here. Basic expansions are processed here also, since %% this function is called from the help functions. --spec expand_options(comp_options()) -> comp_options(). +-spec expand_options(comp_options(), hipe_architecture()) -> comp_options(). -expand_options(Opts) -> +expand_options(Opts, TargetArch) -> proplists:normalize(Opts, [{negations, opt_negations()}, {aliases, opt_aliases()}, {expand, opt_basic_expansions()}, - {expand, opt_expansions()}]). + {expand, opt_expansions(TargetArch)}, + {negations, opt_negations()}]). -spec check_options(comp_options()) -> 'ok'. @@ -1516,4 +1548,31 @@ check_options(Opts) -> ok end. +-spec llvm_support_available() -> boolean(). + +llvm_support_available() -> + get_llvm_version() >= {3,4}. + +-type llvm_version() :: {Major :: integer(), Minor :: integer()}. + +-spec get_llvm_version() -> llvm_version() | {0, 0}. +get_llvm_version() -> + OptStr = os:cmd("opt -version"), + SubStr = "LLVM version ", N = length(SubStr), + case string:str(OptStr, SubStr) of + 0 -> % No opt available + {0, 0}; + S -> + case string:tokens(string:sub_string(OptStr, S + N), ".") of + [MajorS, MinorS | _] -> + case {string:to_integer(MajorS), string:to_integer(MinorS)} of + {{Major, ""}, {Minor, _}} + when is_integer(Major), is_integer(Minor) -> + {Major, Minor}; + _ -> {0, 0} + end; + _ -> {0, 0} %XXX: Assumes no revision numbers in versioning + end + end. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/hipe/main/hipe.hrl.src b/lib/hipe/main/hipe.hrl.src index e74f31b19d..53b59f88f0 100644 --- a/lib/hipe/main/hipe.hrl.src +++ b/lib/hipe/main/hipe.hrl.src @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2011. All Rights Reserved. +%% Copyright Ericsson AB 2001-2015. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -151,7 +152,7 @@ STMNT, ?untagged_msg(Msg ++ "~.2f s\n",[hipe_timing:stop_timer(Timer)/1000])). -else. --define(TIME_STMNT(STMNT,Msg,Timer),STMNT). +-define(TIME_STMNT(STMNT,Msg,Timer), STMNT). -endif. -define(start_timer(Text), hipe_timing:start(Text, ?MODULE)). @@ -161,22 +162,24 @@ -define(get_hipe_timer_val(Timer), get(Timer)). -define(set_hipe_timer_val(Timer, Val), put(Timer, Val)). -define(option_time(Stmnt, Text, Options), - if true -> ?when_option(time, Options, ?start_timer(Text)), - fun(R) -> - ?when_option(time, Options, ?stop_timer(Text)), - R - end(Stmnt)end). + begin + ?when_option(time, Options, ?start_timer(Text)), + fun(R) -> + ?when_option(time, Options, ?stop_timer(Text)), + R + end(Stmnt) + end). --define(option_start_time(Text,Options), +-define(option_start_time(Text, Options), ?when_option(time, Options, ?start_timer(Text))). --define(option_stop_time(Text,Options), +-define(option_stop_time(Text, Options), ?when_option(time, Options, ?stop_timer(Text))). -define(opt_start_timer(Text), - hipe_timing:start_optional_timer(Text,?MODULE)). + hipe_timing:start_optional_timer(Text, ?MODULE)). -define(opt_stop_timer(Text), - hipe_timing:stop_optional_timer(Text,?MODULE)). + hipe_timing:stop_optional_timer(Text, ?MODULE)). %% %% Turn on instrumentation of the compiler. @@ -186,15 +189,15 @@ -define(count_pre_ra_instructions(Options, NoInstrs), ?when_option(count_instrs, Options, put(pre_ra_instrs, - get(pre_ra_instrs)+ NoInstrs))). + get(pre_ra_instrs) + NoInstrs))). -define(count_post_ra_instructions(Options, NoInstrs), ?when_option(count_instrs, Options, put(post_ra_instrs, - get(post_ra_instrs)+ NoInstrs))). + get(post_ra_instrs) + NoInstrs))). -define(start_time_regalloc(Options), ?when_option(timeregalloc, Options, - put(regalloctime1,erlang:statistics(runtime)))). + put(regalloctime1, erlang:statistics(runtime)))). -define(stop_time_regalloc(Options), ?when_option(timeregalloc, Options, put(regalloctime, @@ -214,11 +217,11 @@ -define(count_pre_ra_temps(Options, NoTemps), ?when_option(count_temps, Options, put(pre_ra_temps, - get(pre_ra_temps)+ NoTemps))). + get(pre_ra_temps) + NoTemps))). -define(count_post_ra_temps(Options, NoTemps), ?when_option(count_temps, Options, put(post_ra_temps, - get(post_ra_temps)+ NoTemps))). + get(post_ra_temps) + NoTemps))). -define(inc_counter(Counter, Val), case get(Counter) of @@ -254,7 +257,7 @@ ?count_post_ra_instructions(Options, NoInstrs), ?cons_counter(counter_mem_temps, get(counter_mfa_mem_temps)), ?cons_counter(ra_all_iterations_counter, get(ra_iteration_counter)), - put(ra_iteration_counter,0), + put(ra_iteration_counter, 0), ?count_post_ra_temps(Options, NoTemps) end). @@ -263,12 +266,12 @@ put(spilledtemps, get(spilledtemps) + NoSpills))). -define(optional_start_timer(Timer, Options), - case lists:member(Timer, proplists:get_value(timers,Options++[{timers,[]}])) of + case lists:member(Timer, proplists:get_value(timers, Options++[{timers,[]}])) of true -> ?start_hipe_timer(Timer); false -> true end). -define(optional_stop_timer(Timer, Options), - case lists:member(Timer, proplists:get_value(timers,Options++[{timers,[]}])) of + case lists:member(Timer, proplists:get_value(timers, Options++[{timers,[]}])) of true -> ?stop_hipe_timer(Timer); false -> true end). @@ -298,7 +301,8 @@ %% Records defined in the hipe module used in other parts of the compiler %%---------------------------------------------------------------------------- --record(comp_servers, {pp_server :: pid(), range :: pid(), type :: pid()}). +-type mpid() :: 'none' | pid(). +-record(comp_servers, {pp_server :: mpid(), range :: mpid(), type :: mpid()}). %%---------------------------------------------------------------------------- %% Basic types of the 'hipe' application used in other parts of the system @@ -314,4 +318,4 @@ 'unknown' | {'reg' | 'fp_reg' | 'spill', non_neg_integer()}}]. -type hipe_temp_map() :: tuple(). --type hipe_spill_map() :: [{non_neg_integer(), {'spill',non_neg_integer()}}]. +-type hipe_spill_map() :: [{non_neg_integer(), {'spill', non_neg_integer()}}]. diff --git a/lib/hipe/main/hipe_main.erl b/lib/hipe/main/hipe_main.erl index 99028cc3c1..4b89feb48a 100644 --- a/lib/hipe/main/hipe_main.erl +++ b/lib/hipe/main/hipe_main.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2011. All Rights Reserved. +%% Copyright Ericsson AB 2001-2015. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -49,12 +50,12 @@ %%===================================================================== -type comp_icode_ret() :: {'native',hipe_architecture(),{'unprofiled',_}} - | {'rtl',tuple()}. + | {'rtl',tuple()} | {'llvm_binary',term()}. %%===================================================================== %% @spec compile_icode(MFA::mfa(), -%% LinearIcode::#icode{}, +%% LinearIcode::icode(), %% CompilerOptions::comp_options(), %% CompServers::#comp_servers()) -> %% {native,Platform,{unprofiled,NativeCode}} | {rtl,RTLCode} @@ -68,7 +69,7 @@ %% generated). The compiler options must have already been expanded %% (cf. `<a href="hipe.html">hipe:expand_options</a>'). </p> --spec compile_icode(mfa(), #icode{}, comp_options(), #comp_servers{}) -> +-spec compile_icode(mfa(), icode(), comp_options(), #comp_servers{}) -> comp_icode_ret(). compile_icode(MFA, LinearIcode, Options, Servers) -> @@ -115,11 +116,18 @@ compile_icode(MFA, LinearIcode0, Options, Servers, DebugState) -> pp(IcodeCfg7, MFA, icode_liveness, pp_icode_liveness, Options, Servers), FinalIcode = hipe_icode_cfg:cfg_to_linear(IcodeCfg7), ?opt_stop_timer("Icode"), - LinearRTL = ?option_time(icode_to_rtl(MFA,FinalIcode,Options, Servers), - "RTL", Options), + {LinearRTL, Roots} = ?option_time(icode_to_rtl(MFA, FinalIcode, Options, Servers), + "RTL", Options), case proplists:get_bool(to_rtl, Options) of false -> - rtl_to_native(MFA, LinearRTL, Options, DebugState); + case proplists:get_bool(to_llvm, Options) of + false -> + rtl_to_native(MFA, LinearRTL, Options, DebugState); + true -> + %% The LLVM backend returns binary code, unlike the rest of the HiPE + %% backends which return native assembly. + rtl_to_llvm_to_binary(MFA, LinearRTL, Roots, Options, DebugState) + end; true -> put(hipe_debug, DebugState), {rtl, LinearRTL} @@ -222,10 +230,12 @@ get_pp_module(icode_liveness) -> hipe_icode_liveness; get_pp_module(rtl_liveness) -> hipe_rtl_liveness. perform_io(no_fun, _) -> ok; -perform_io(Fun,PPServer) when is_pid(PPServer) -> - PPServer ! {print,Fun}; -perform_io(Fun, undefined) -> - Fun(). +perform_io(Fun, PPServer) when is_pid(PPServer) -> + PPServer ! {print, Fun}, + ok; +perform_io(Fun, none) -> + Fun(), + ok. %%-------------------------------------------------------------------- @@ -274,8 +284,9 @@ icode_ssa_type(IcodeSSA, MFA, Options, Servers) -> false -> AnnIcode1 end, AnnIcode3 = icode_range_analysis(AnnIcode2, MFA, Options, Servers), - pp(AnnIcode3, MFA, icode, pp_range_icode, Options, Servers), - hipe_icode_type:unannotate_cfg(AnnIcode3) + AnnIcode4 = icode_eliminate_safe_calls(AnnIcode3, Options), + pp(AnnIcode4, MFA, icode, pp_range_icode, Options, Servers), + hipe_icode_type:unannotate_cfg(AnnIcode4) end. icode_ssa_convert(IcodeCfg, Options) -> @@ -285,7 +296,7 @@ icode_ssa_convert(IcodeCfg, Options) -> icode_ssa_const_prop(IcodeSSA, Options) -> case proplists:get_bool(icode_ssa_const_prop, Options) of true -> - ?option_time(Tmp=hipe_icode_ssa_const_prop:propagate(IcodeSSA), + Tmp = ?option_time(hipe_icode_ssa_const_prop:propagate(IcodeSSA), "Icode SSA sparse conditional constant propagation", Options), ?option_time(hipe_icode_ssa:remove_dead_code(Tmp), "Icode SSA dead code elimination pass 1", Options); @@ -324,6 +335,15 @@ icode_range_analysis(IcodeSSA, MFA, Options, Servers) -> IcodeSSA end. +icode_eliminate_safe_calls(IcodeSSA, Options) -> + case proplists:get_bool(icode_call_elim, Options) of + true -> + ?option_time(hipe_icode_call_elim:cfg(IcodeSSA), + "Icode SSA safe call elimination", Options); + false -> + IcodeSSA + end. + icode_ssa_dead_code_elimination(IcodeSSA, Options) -> IcodeSSA1 = ?option_time(hipe_icode_ssa:remove_dead_code(IcodeSSA), "Icode SSA dead code elimination pass 2", @@ -385,11 +405,21 @@ icode_to_rtl(MFA, Icode, Options, Servers) -> %% hipe_rtl_cfg:pp(RtlCfg3), pp(RtlCfg3, MFA, rtl_liveness, pp_rtl_liveness, Options, Servers), RtlCfg4 = rtl_lcm(RtlCfg3, Options), - pp(RtlCfg4, MFA, rtl, pp_rtl, Options, Servers), - LinearRTL1 = hipe_rtl_cfg:linearize(RtlCfg4), + %% LLVM: A liveness analysis on RTL must be performed in order to find the GC + %% roots and explicitly mark them (in RTL) when they go out of scope (only + %% when the LLVM backend is used). + {RtlCfg5, Roots} = + case proplists:get_bool(to_llvm, Options) of + false -> + {RtlCfg4, []}; + true -> + hipe_llvm_liveness:analyze(RtlCfg4) + end, + pp(RtlCfg5, MFA, rtl, pp_rtl, Options, Servers), + LinearRTL1 = hipe_rtl_cfg:linearize(RtlCfg5), LinearRTL2 = hipe_rtl_cleanup_const:cleanup(LinearRTL1), %% hipe_rtl:pp(standard_io, LinearRTL2), - LinearRTL2. + {LinearRTL2, Roots}. translate_to_rtl(Icode, Options) -> %% GC tests should have been added in the conversion to Icode. @@ -540,6 +570,17 @@ rtl_to_native(MFA, LinearRTL, Options, DebugState) -> put(hipe_debug, DebugState), LinearNativeCode. +%% Translate Linear RTL to binary code using LLVM. +rtl_to_llvm_to_binary(MFA, LinearRTL, Roots, Options, DebugState) -> + ?opt_start_timer("LLVM native code"), + %% BinaryCode is a tuple, as defined in llvm/hipe_llvm_main module, which + %% contains the binary code together with info needed by the loader, e.g. + %% ConstTab, Refs, LabelMap, etc. + BinaryCode = hipe_llvm_main:rtl_to_native(MFA, LinearRTL, Roots, Options), + ?opt_stop_timer("LLVM native code"), + put(hipe_debug, DebugState), + {llvm_binary, BinaryCode}. + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% Debugging stuff ... %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/hipe/misc/Makefile b/lib/hipe/misc/Makefile index 16166f552c..72cfff21a8 100644 --- a/lib/hipe/misc/Makefile +++ b/lib/hipe/misc/Makefile @@ -1,18 +1,19 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2001-2012. All Rights Reserved. +# Copyright Ericsson AB 2001-2016. All Rights Reserved. # -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at # -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. # # %CopyrightEnd% # @@ -68,7 +69,7 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += +warn_exported_vars +warn_missing_spec +warn_untyped_record +ERL_COMPILE_FLAGS += -Werror +warn_export_vars +warn_missing_spec +warn_untyped_record # ---------------------------------------------------- # Targets diff --git a/lib/hipe/misc/hipe_consttab.erl b/lib/hipe/misc/hipe_consttab.erl index c381e6a057..226b20fa46 100644 --- a/lib/hipe/misc/hipe_consttab.erl +++ b/lib/hipe/misc/hipe_consttab.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -86,7 +87,8 @@ % {NewTab, Lbl} insert_sorted_block/4, insert_block/3, - %% insert_global_word/2, + insert_binary_const/3, + %% insert_global_word/2, %% insert_global_block/4, %% update_word/3, % update_word(ConstTab, Value) -> {NewTab, Lbl} %% update_block/5, @@ -195,6 +197,16 @@ insert_block({ConstTab, RefToLabels, NextLabel}, ElementType, InitList) -> {ElementType,InitList}), {insert_backrefs(NewTa, Id, ReferredLabels), Id}. +%% @doc Inserts a binary constant literal into the const table. +-spec insert_binary_const(hipe_consttab(), ct_alignment(), binary()) -> + {hipe_consttab(), hipe_constlbl()}. +insert_binary_const(ConstTab, Alignment, Binary) + when (Alignment =:= 4 orelse Alignment =:= 8 orelse Alignment =:= 16 + orelse Alignment =:= 32), is_binary(Binary), + size(Binary) rem Alignment =:= 0 -> + insert_const(ConstTab, block, Alignment, false, + {byte, binary_to_list(Binary)}). + %% @spec (ConstTab::hipe_consttab(), ElementType::element_type(), %% InitList::block(), SortOrder) -> {hipe_consttab(), hipe_constlbl()} @@ -462,7 +474,7 @@ update_referred_labels(Table, LabelMap) -> tree_keys(T) -> dict:fetch_keys(T). --spec tree_to_list(dict()) -> [{_, _}]. +-spec tree_to_list(dict:dict()) -> [{_, _}]. tree_to_list(T) -> dict:to_list(T). @@ -486,11 +498,11 @@ tree_lookup(Key, T) -> none end. --spec tree_empty() -> dict(). +-spec tree_empty() -> dict:dict(). tree_empty() -> dict:new(). --spec tree_lookup_key_for_value(ctdata(), dict()) -> 'none' | {'value', _}. +-spec tree_lookup_key_for_value(ctdata(), dict:dict()) -> 'none' | {'value', _}. tree_lookup_key_for_value(Val, T) -> tree_lookup_key_for_value_1(tree_to_list(T), Val). diff --git a/lib/hipe/misc/hipe_consttab.hrl b/lib/hipe/misc/hipe_consttab.hrl index 39018dac34..550da0455c 100644 --- a/lib/hipe/misc/hipe_consttab.hrl +++ b/lib/hipe/misc/hipe_consttab.hrl @@ -2,26 +2,27 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2009. All Rights Reserved. +%% Copyright Ericsson AB 2008-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% %%----------------------------------------------------------------------------- --type ct_alignment() :: 4 | 8. +-type ct_alignment() :: 4 | 8 | 16 | 32. -type hipe_constlbl() :: non_neg_integer(). --type hipe_consttab() :: {dict(), [hipe_constlbl()], hipe_constlbl()}. +-type hipe_consttab() :: {dict:dict(), [hipe_constlbl()], hipe_constlbl()}. %%----------------------------------------------------------------------------- diff --git a/lib/hipe/misc/hipe_data_pp.erl b/lib/hipe/misc/hipe_data_pp.erl index 0f206e8ade..6cdc6c5ad2 100644 --- a/lib/hipe/misc/hipe_data_pp.erl +++ b/lib/hipe/misc/hipe_data_pp.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/misc/hipe_gensym.erl b/lib/hipe/misc/hipe_gensym.erl index 84fc8fa7e8..da7c4f9a5d 100644 --- a/lib/hipe/misc/hipe_gensym.erl +++ b/lib/hipe/misc/hipe_gensym.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -44,7 +45,7 @@ %% Types of allowable entities to set global variables for %%----------------------------------------------------------------------- --type gvarname() :: 'icode' | 'rtl' | 'arm' | 'ppc' | 'sparc' | 'x86'. +-type gvarname() :: 'icode' | 'rtl' | 'arm' | 'ppc' | 'sparc' | 'x86' | 'llvm'. %%----------------------------------------------------------------------- diff --git a/lib/hipe/misc/hipe_pack_constants.erl b/lib/hipe/misc/hipe_pack_constants.erl index e214d7ebbc..b54830dd57 100644 --- a/lib/hipe/misc/hipe_pack_constants.erl +++ b/lib/hipe/misc/hipe_pack_constants.erl @@ -3,47 +3,66 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2009. All Rights Reserved. +%% Copyright Ericsson AB 2003-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% -module(hipe_pack_constants). --export([pack_constants/2, slim_refs/1, slim_constmap/1]). +-export([pack_constants/2, slim_refs/1, slim_constmap/1, + find_const/2, mk_data_relocs/2, slim_sorted_exportmap/3]). -include("hipe_consttab.hrl"). -include("../../kernel/src/hipe_ext_format.hrl"). +-include("../main/hipe.hrl"). % Needed for the EXIT macro in find_const/2. %%----------------------------------------------------------------------------- --type raw_data() :: binary() | number() | list() | tuple(). --type tbl_ref() :: {hipe_constlbl(), non_neg_integer()}. +-type const_num() :: non_neg_integer(). +-type raw_data() :: binary() | number() | list() | tuple(). + +-type addr() :: non_neg_integer(). +-type ref_p() :: {DataPos :: hipe_constlbl(), CodeOffset :: addr()}. +-type ref() :: ref_p() | {'sorted', Base :: addr(), [ref_p()]}. + +-type mfa_refs() :: {mfa(), [ref()]}. + +%% XXX: these types may not belong here: FIX! +-type fa() :: {atom(), arity()}. +-type export_map() :: [{addr(), module(), atom(), arity()}]. -record(pcm_entry, {mfa :: mfa(), label :: hipe_constlbl(), - const_num :: non_neg_integer(), - start :: non_neg_integer(), + const_num :: const_num(), + start :: addr(), type :: 0 | 1 | 2, raw_data :: raw_data()}). +-type pcm_entry() :: #pcm_entry{}. + +-type label_map() :: gb_trees:tree({mfa(), hipe_constlbl()}, addr()). + +%% Some of the following types may possibly need to be exported +-type data_relocs() :: [ref()]. +-type packed_const_map() :: [pcm_entry()]. +-type mfa_refs_map() :: [mfa_refs()]. +-type slim_export_map() :: [addr() | module() | atom() | arity() | boolean()]. %%----------------------------------------------------------------------------- -spec pack_constants([{mfa(),[_],hipe_consttab()}], ct_alignment()) -> - {ct_alignment(), - non_neg_integer(), - [#pcm_entry{}], - [{mfa(),[tbl_ref() | {'sorted',non_neg_integer(),[tbl_ref()]}]}]}. + {ct_alignment(), non_neg_integer(), packed_const_map(), mfa_refs_map()}. pack_constants(Data, Align) -> pack_constants(Data, 0, Align, 0, [], []). @@ -194,13 +213,12 @@ compact_dests([], Dest, AccofDest, Acc) -> %% to the slimmed and flattened format ConstMap which is put in object %% files. %% --spec slim_constmap([#pcm_entry{}]) -> [raw_data()]. +-spec slim_constmap(packed_const_map()) -> [raw_data()]. slim_constmap(Map) -> slim_constmap(Map, gb_sets:new(), []). --spec slim_constmap([#pcm_entry{}], gb_set(), [raw_data()]) -> [raw_data()]. -slim_constmap([#pcm_entry{const_num=ConstNo, start=Offset, - type=Type, raw_data=Term}|Rest], Inserted, Acc) -> +slim_constmap([#pcm_entry{const_num = ConstNo, start = Offset, + type = Type, raw_data = Term}|Rest], Inserted, Acc) -> case gb_sets:is_member(ConstNo, Inserted) of true -> slim_constmap(Rest, Inserted, Acc); @@ -209,3 +227,60 @@ slim_constmap([#pcm_entry{const_num=ConstNo, start=Offset, slim_constmap(Rest, NewInserted, [ConstNo, Offset, Type, Term|Acc]) end; slim_constmap([], _Inserted, Acc) -> Acc. + +%% +%% Lookup a constant in a ConstMap. +%% +-spec find_const({mfa(), hipe_constlbl()}, packed_const_map()) -> const_num(). + +find_const({MFA, Label}, [E = #pcm_entry{mfa = MFA, label = Label}|_]) -> + E#pcm_entry.const_num; +find_const(N, [_|R]) -> + find_const(N, R); +find_const(C, []) -> + ?EXIT({constant_not_found, C}). + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +%% +%% Functions to build and handle Refs, ExportMap and LabelMap. +%% Note: Moved here because they are used by all backends in +%% hipe_{arm,sparc,ppc,x86}_assemble.erl +%% XXX: Is this the right place for them? +%% + +-spec mk_data_relocs(mfa_refs_map(), label_map()) -> data_relocs(). + +mk_data_relocs(RefsFromConsts, LabelMap) -> + lists:flatten(mk_data_relocs(RefsFromConsts, LabelMap, [])). + +mk_data_relocs([{MFA, Labels} | Rest], LabelMap, Acc) -> + Map = [case Label of + {L,Pos} -> + Offset = find({MFA,L}, LabelMap), + {Pos,Offset}; + {sorted,Base,OrderedLabels} -> + {sorted, Base, [begin + Offset = find({MFA,L}, LabelMap), + {Order, Offset} + end + || {L,Order} <- OrderedLabels]} + end + || Label <- Labels], + %% msg("Map: ~w Map\n", [Map]), + mk_data_relocs(Rest, LabelMap, [Map,Acc]); +mk_data_relocs([], _, Acc) -> Acc. + +find({MFA,L}, LabelMap) -> + gb_trees:get({MFA,L}, LabelMap). + +-spec slim_sorted_exportmap(export_map(), [mfa()], [fa()]) -> slim_export_map(). + +slim_sorted_exportmap([{Addr,M,F,A}|Rest], Closures, Exports) -> + IsClosure = lists:member({M,F,A}, Closures), + IsExported = is_exported(F, A, Exports), + [Addr,M,F,A,IsClosure,IsExported | slim_sorted_exportmap(Rest, Closures, Exports)]; +slim_sorted_exportmap([], _, _) -> []. + +is_exported(F, A, Exports) -> + lists:member({F,A}, Exports). diff --git a/lib/hipe/misc/hipe_sdi.erl b/lib/hipe/misc/hipe_sdi.erl index ef1b5b48c5..fbb4b105f6 100644 --- a/lib/hipe/misc/hipe_sdi.erl +++ b/lib/hipe/misc/hipe_sdi.erl @@ -3,18 +3,19 @@ %%% %%% %CopyrightBegin% %%% -%%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %%% -%%% The contents of this file are subject to the Erlang Public License, -%%% Version 1.1, (the "License"); you may not use this file except in -%%% compliance with the License. You should have received a copy of the -%%% Erlang Public License along with this software. If not, it can be -%%% retrieved online at http://www.erlang.org/. -%%% -%%% Software distributed under the License is distributed on an "AS IS" -%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%%% the License for the specific language governing rights and limitations -%%% under the License. +%%% Licensed under the Apache License, Version 2.0 (the "License"); +%%% you may not use this file except in compliance with the License. +%%% You may obtain a copy of the License at +%%% +%%% http://www.apache.org/licenses/LICENSE-2.0 +%%% +%%% Unless required by applicable law or agreed to in writing, software +%%% distributed under the License is distributed on an "AS IS" BASIS, +%%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%%% See the License for the specific language governing permissions and +%%% limitations under the License. %%% %%% %CopyrightEnd% %%% @@ -50,7 +51,7 @@ -record(pass1, {prevSdi :: integer(), preS = [] :: [#pre_sdi_data{}], - labelMap = gb_trees:empty() :: gb_tree()}). + labelMap = gb_trees:empty() :: gb_trees:tree()}). -record(sdi_data, {address :: address(), label_address :: address(), @@ -105,11 +106,11 @@ pass1_add_sdi(Pass1, Address, Label, SdiInfo) -> PreSdiData = #pre_sdi_data{address=Address, label=Label, si=SdiInfo}, Pass1#pass1{prevSdi=PrevSdi+1, preS=[PreSdiData|PreS]}. --spec pass1_finalise(#pass1{}) -> {non_neg_integer(),tuple(),gb_tree()}. +-spec pass1_finalise(#pass1{}) -> {non_neg_integer(),tuple(),gb_trees:tree()}. pass1_finalise(#pass1{prevSdi=PrevSdi, preS=PreS, labelMap=LabelMap}) -> {PrevSdi+1, pass1_finalise_preS(PreS, LabelMap, []), LabelMap}. --spec pass1_finalise_preS([#pre_sdi_data{}], gb_tree(), [#sdi_data{}]) -> +-spec pass1_finalise_preS([#pre_sdi_data{}], gb_trees:tree(), [#sdi_data{}]) -> tuple(). pass1_finalise_preS([], _LabelMap, S) -> vector_from_list(S); pass1_finalise_preS([PreSdiData|PreS], LabelMap, S) -> @@ -122,7 +123,7 @@ pass1_finalise_preS([PreSdiData|PreS], LabelMap, S) -> %%% Pass2. --spec pass2(#pass1{}) -> {gb_tree(), non_neg_integer()}. +-spec pass2(#pass1{}) -> {gb_trees:tree(), non_neg_integer()}. pass2(Pass1) -> {N,SDIS,LabelMap} = pass1_finalise(Pass1), LONG = mk_long(N), @@ -339,13 +340,14 @@ initINCR(SdiNr, PrevIncr, N, LONG, INCREMENT) -> %%% a and previous sdi i is remapped to a+incr(i), where %%% incr(i) = if i < 0 then 0 else INCREMENT[i]. --spec adjust_label_map(gb_tree(), hipe_array()) -> gb_tree(). +-spec adjust_label_map(gb_trees:tree(), hipe_array()) -> gb_trees:tree(). adjust_label_map(LabelMap, INCREMENT) -> applyIncr(gb_trees:to_list(LabelMap), INCREMENT, gb_trees:empty()). -type label_pair() :: {label(), #label_data{}}. --spec applyIncr([label_pair()], hipe_array(), gb_tree()) -> gb_tree(). +-spec applyIncr([label_pair()], hipe_array(), gb_trees:tree()) -> + gb_trees:tree(). applyIncr([], _INCREMENT, LabelMap) -> LabelMap; applyIncr([{Label,LabelData}|List], INCREMENT, LabelMap) -> #label_data{address=Address, prevSdi=PrevSdi} = LabelData, diff --git a/lib/hipe/misc/hipe_sdi.hrl b/lib/hipe/misc/hipe_sdi.hrl index f89cae1529..a1e12f9df2 100644 --- a/lib/hipe/misc/hipe_sdi.hrl +++ b/lib/hipe/misc/hipe_sdi.hrl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/opt/Makefile b/lib/hipe/opt/Makefile index a21c543574..684d6f45b4 100644 --- a/lib/hipe/opt/Makefile +++ b/lib/hipe/opt/Makefile @@ -1,18 +1,19 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2001-2012. All Rights Reserved. +# Copyright Ericsson AB 2001-2016. All Rights Reserved. # -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at # -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. # # %CopyrightEnd% # @@ -63,7 +64,7 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += +warn_exported_vars +warn_missing_spec # +warn_untyped_record +ERL_COMPILE_FLAGS += -Werror +warn_export_vars +warn_missing_spec # +warn_untyped_record # ---------------------------------------------------- # Targets diff --git a/lib/hipe/opt/hipe_schedule.erl b/lib/hipe/opt/hipe_schedule.erl index 4f153e17ad..00ad487620 100644 --- a/lib/hipe/opt/hipe_schedule.erl +++ b/lib/hipe/opt/hipe_schedule.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2011. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/opt/hipe_schedule_prio.erl b/lib/hipe/opt/hipe_schedule_prio.erl index 4d078b007d..3dcc0845e0 100644 --- a/lib/hipe/opt/hipe_schedule_prio.erl +++ b/lib/hipe/opt/hipe_schedule_prio.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/opt/hipe_spillmin.erl b/lib/hipe/opt/hipe_spillmin.erl index df885a7dff..4eeb1d71db 100644 --- a/lib/hipe/opt/hipe_spillmin.erl +++ b/lib/hipe/opt/hipe_spillmin.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/opt/hipe_spillmin_color.erl b/lib/hipe/opt/hipe_spillmin_color.erl index 11a281100b..7c23de44b4 100644 --- a/lib/hipe/opt/hipe_spillmin_color.erl +++ b/lib/hipe/opt/hipe_spillmin_color.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/opt/hipe_spillmin_scan.erl b/lib/hipe/opt/hipe_spillmin_scan.erl index c58906c389..06b68e1934 100644 --- a/lib/hipe/opt/hipe_spillmin_scan.erl +++ b/lib/hipe/opt/hipe_spillmin_scan.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/opt/hipe_target_machine.erl b/lib/hipe/opt/hipe_target_machine.erl index be9f095429..f64bb8b518 100644 --- a/lib/hipe/opt/hipe_target_machine.erl +++ b/lib/hipe/opt/hipe_target_machine.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/opt/hipe_ultra_mod2.erl b/lib/hipe/opt/hipe_ultra_mod2.erl index b039eaee80..f28c4e6939 100644 --- a/lib/hipe/opt/hipe_ultra_mod2.erl +++ b/lib/hipe/opt/hipe_ultra_mod2.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/opt/hipe_ultra_prio.erl b/lib/hipe/opt/hipe_ultra_prio.erl index 9e2c1a0489..423dc0d6bf 100644 --- a/lib/hipe/opt/hipe_ultra_prio.erl +++ b/lib/hipe/opt/hipe_ultra_prio.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/ppc/Makefile b/lib/hipe/ppc/Makefile index 8bd2a8226c..1901dfa671 100644 --- a/lib/hipe/ppc/Makefile +++ b/lib/hipe/ppc/Makefile @@ -1,18 +1,19 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2004-2012. All Rights Reserved. +# Copyright Ericsson AB 2004-2016. All Rights Reserved. # -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at # -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. # # %CopyrightEnd% # @@ -75,7 +76,7 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += +warn_exported_vars +ERL_COMPILE_FLAGS += -Werror +warn_export_vars # ---------------------------------------------------- # Targets diff --git a/lib/hipe/ppc/hipe_ppc.erl b/lib/hipe/ppc/hipe_ppc.erl index 4014fc1561..0fa96162f6 100644 --- a/lib/hipe/ppc/hipe_ppc.erl +++ b/lib/hipe/ppc/hipe_ppc.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2011. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/ppc/hipe_ppc.hrl b/lib/hipe/ppc/hipe_ppc.hrl index 25e7ae0b5f..aa8ff4a3f7 100644 --- a/lib/hipe/ppc/hipe_ppc.hrl +++ b/lib/hipe/ppc/hipe_ppc.hrl @@ -2,18 +2,19 @@ %%% %%% %CopyrightBegin% %%% -%%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %%% -%%% The contents of this file are subject to the Erlang Public License, -%%% Version 1.1, (the "License"); you may not use this file except in -%%% compliance with the License. You should have received a copy of the -%%% Erlang Public License along with this software. If not, it can be -%%% retrieved online at http://www.erlang.org/. -%%% -%%% Software distributed under the License is distributed on an "AS IS" -%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%%% the License for the specific language governing rights and limitations -%%% under the License. +%%% Licensed under the Apache License, Version 2.0 (the "License"); +%%% you may not use this file except in compliance with the License. +%%% You may obtain a copy of the License at +%%% +%%% http://www.apache.org/licenses/LICENSE-2.0 +%%% +%%% Unless required by applicable law or agreed to in writing, software +%%% distributed under the License is distributed on an "AS IS" BASIS, +%%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%%% See the License for the specific language governing permissions and +%%% limitations under the License. %%% %%% %CopyrightEnd% %%% diff --git a/lib/hipe/ppc/hipe_ppc_assemble.erl b/lib/hipe/ppc/hipe_ppc_assemble.erl index b2fd50517b..ff9da01b11 100644 --- a/lib/hipe/ppc/hipe_ppc_assemble.erl +++ b/lib/hipe/ppc/hipe_ppc_assemble.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2011. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -46,10 +47,10 @@ assemble(CompiledCode, Closures, Exports, Options) -> print("Total num bytes=~w\n", [CodeSize], Options), %% SC = hipe_pack_constants:slim_constmap(ConstMap), - DataRelocs = mk_data_relocs(RefsFromConsts, LabelMap), - SSE = slim_sorted_exportmap(ExportMap,Closures,Exports), + DataRelocs = hipe_pack_constants:mk_data_relocs(RefsFromConsts, LabelMap), + SSE = hipe_pack_constants:slim_sorted_exportmap(ExportMap,Closures,Exports), SlimRefs = hipe_pack_constants:slim_refs(AccRefs), - Bin = term_to_binary([{?VERSION_STRING(),?HIPE_SYSTEM_CRC}, + Bin = term_to_binary([{?VERSION_STRING(),?HIPE_ERTS_CHECKSUM}, ConstAlign, ConstSize, SC, DataRelocs, % nee LM, LabelMap @@ -288,7 +289,7 @@ do_pseudo_li(I, MFA, ConstMap) -> %%% end, %%% {load_address, {Tag,untag_mfa_or_prim(MFAorPrim)}}; {Label,constant} -> - ConstNo = find_const({MFA,Label}, ConstMap), + ConstNo = hipe_pack_constants:find_const({MFA,Label}, ConstMap), {load_address, {constant,ConstNo}}; {Label,closure} -> {load_address, {closure,Label}}; @@ -574,37 +575,6 @@ mk_y(Pred, BD) -> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -mk_data_relocs(RefsFromConsts, LabelMap) -> - lists:flatten(mk_data_relocs(RefsFromConsts, LabelMap, [])). - -mk_data_relocs([{MFA,Labels} | Rest], LabelMap, Acc) -> - Map = [case Label of - {L,Pos} -> - Offset = find({MFA,L}, LabelMap), - {Pos,Offset}; - {sorted,Base,OrderedLabels} -> - {sorted, Base, [begin - Offset = find({MFA,L}, LabelMap), - {Order, Offset} - end - || {L,Order} <- OrderedLabels]} - end - || Label <- Labels], - %% msg("Map: ~w Map\n",[Map]), - mk_data_relocs(Rest, LabelMap, [Map,Acc]); -mk_data_relocs([],_,Acc) -> Acc. - -find({_MFA,_L} = MFAL,LabelMap) -> - gb_trees:get(MFAL, LabelMap). - -slim_sorted_exportmap([{Addr,M,F,A}|Rest], Closures, Exports) -> - IsClosure = lists:member({M,F,A}, Closures), - IsExported = is_exported(F, A, Exports), - [Addr,M,F,A,IsClosure,IsExported | slim_sorted_exportmap(Rest, Closures, Exports)]; -slim_sorted_exportmap([],_,_) -> []. - -is_exported(F, A, Exports) -> lists:member({F,A}, Exports). - %%% %%% Assembly listing support (pp_asm option). %%% @@ -642,14 +612,3 @@ fill_spaces(N) when N > 0 -> fill_spaces(N-1); fill_spaces(0) -> []. - -%%% -%%% Lookup a constant in a ConstMap. -%%% - -find_const({MFA,Label}, [{pcm_entry,MFA,Label,ConstNo,_,_,_}|_]) -> - ConstNo; -find_const(N, [_|R]) -> - find_const(N, R); -find_const(C, []) -> - ?EXIT({constant_not_found,C}). diff --git a/lib/hipe/ppc/hipe_ppc_cfg.erl b/lib/hipe/ppc/hipe_ppc_cfg.erl index 13a7754831..34d4bf54c5 100644 --- a/lib/hipe/ppc/hipe_ppc_cfg.erl +++ b/lib/hipe/ppc/hipe_ppc_cfg.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/ppc/hipe_ppc_defuse.erl b/lib/hipe/ppc/hipe_ppc_defuse.erl index 03a8f82abf..77b84dc574 100644 --- a/lib/hipe/ppc/hipe_ppc_defuse.erl +++ b/lib/hipe/ppc/hipe_ppc_defuse.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/ppc/hipe_ppc_encode.erl b/lib/hipe/ppc/hipe_ppc_encode.erl index 97cb0bf635..793f6ccc02 100644 --- a/lib/hipe/ppc/hipe_ppc_encode.erl +++ b/lib/hipe/ppc/hipe_ppc_encode.erl @@ -2,18 +2,19 @@ %%% %%% %CopyrightBegin% %%% -%%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %%% -%%% The contents of this file are subject to the Erlang Public License, -%%% Version 1.1, (the "License"); you may not use this file except in -%%% compliance with the License. You should have received a copy of the -%%% Erlang Public License along with this software. If not, it can be -%%% retrieved online at http://www.erlang.org/. -%%% -%%% Software distributed under the License is distributed on an "AS IS" -%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%%% the License for the specific language governing rights and limitations -%%% under the License. +%%% Licensed under the Apache License, Version 2.0 (the "License"); +%%% you may not use this file except in compliance with the License. +%%% You may obtain a copy of the License at +%%% +%%% http://www.apache.org/licenses/LICENSE-2.0 +%%% +%%% Unless required by applicable law or agreed to in writing, software +%%% distributed under the License is distributed on an "AS IS" BASIS, +%%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%%% See the License for the specific language governing permissions and +%%% limitations under the License. %%% %%% %CopyrightEnd% %%% diff --git a/lib/hipe/ppc/hipe_ppc_finalise.erl b/lib/hipe/ppc/hipe_ppc_finalise.erl index c4b9526fec..8bb9520f89 100644 --- a/lib/hipe/ppc/hipe_ppc_finalise.erl +++ b/lib/hipe/ppc/hipe_ppc_finalise.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/ppc/hipe_ppc_frame.erl b/lib/hipe/ppc/hipe_ppc_frame.erl index 8a4d1906c0..ff0450270f 100644 --- a/lib/hipe/ppc/hipe_ppc_frame.erl +++ b/lib/hipe/ppc/hipe_ppc_frame.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2011. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/ppc/hipe_ppc_liveness_all.erl b/lib/hipe/ppc/hipe_ppc_liveness_all.erl index c9234e8100..cab7605967 100644 --- a/lib/hipe/ppc/hipe_ppc_liveness_all.erl +++ b/lib/hipe/ppc/hipe_ppc_liveness_all.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/ppc/hipe_ppc_liveness_fpr.erl b/lib/hipe/ppc/hipe_ppc_liveness_fpr.erl index ff9db21e2b..1437e27508 100644 --- a/lib/hipe/ppc/hipe_ppc_liveness_fpr.erl +++ b/lib/hipe/ppc/hipe_ppc_liveness_fpr.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/ppc/hipe_ppc_liveness_gpr.erl b/lib/hipe/ppc/hipe_ppc_liveness_gpr.erl index a55052b944..074fada918 100644 --- a/lib/hipe/ppc/hipe_ppc_liveness_gpr.erl +++ b/lib/hipe/ppc/hipe_ppc_liveness_gpr.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/ppc/hipe_ppc_main.erl b/lib/hipe/ppc/hipe_ppc_main.erl index 1d84f6db11..fd5cc2befb 100644 --- a/lib/hipe/ppc/hipe_ppc_main.erl +++ b/lib/hipe/ppc/hipe_ppc_main.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/ppc/hipe_ppc_pp.erl b/lib/hipe/ppc/hipe_ppc_pp.erl index f88e922808..e69e6b64a2 100644 --- a/lib/hipe/ppc/hipe_ppc_pp.erl +++ b/lib/hipe/ppc/hipe_ppc_pp.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/ppc/hipe_ppc_ra.erl b/lib/hipe/ppc/hipe_ppc_ra.erl index 3de7f48de1..87c776f5d1 100644 --- a/lib/hipe/ppc/hipe_ppc_ra.erl +++ b/lib/hipe/ppc/hipe_ppc_ra.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/ppc/hipe_ppc_ra_finalise.erl b/lib/hipe/ppc/hipe_ppc_ra_finalise.erl index 53f8b739c2..ea163221c2 100644 --- a/lib/hipe/ppc/hipe_ppc_ra_finalise.erl +++ b/lib/hipe/ppc/hipe_ppc_ra_finalise.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/ppc/hipe_ppc_ra_ls.erl b/lib/hipe/ppc/hipe_ppc_ra_ls.erl index 0b5d915ee8..6e8304467e 100644 --- a/lib/hipe/ppc/hipe_ppc_ra_ls.erl +++ b/lib/hipe/ppc/hipe_ppc_ra_ls.erl @@ -2,18 +2,19 @@ %%% %%% %CopyrightBegin% %%% -%%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %%% -%%% The contents of this file are subject to the Erlang Public License, -%%% Version 1.1, (the "License"); you may not use this file except in -%%% compliance with the License. You should have received a copy of the -%%% Erlang Public License along with this software. If not, it can be -%%% retrieved online at http://www.erlang.org/. -%%% -%%% Software distributed under the License is distributed on an "AS IS" -%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%%% the License for the specific language governing rights and limitations -%%% under the License. +%%% Licensed under the Apache License, Version 2.0 (the "License"); +%%% you may not use this file except in compliance with the License. +%%% You may obtain a copy of the License at +%%% +%%% http://www.apache.org/licenses/LICENSE-2.0 +%%% +%%% Unless required by applicable law or agreed to in writing, software +%%% distributed under the License is distributed on an "AS IS" BASIS, +%%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%%% See the License for the specific language governing permissions and +%%% limitations under the License. %%% %%% %CopyrightEnd% %%% diff --git a/lib/hipe/ppc/hipe_ppc_ra_naive.erl b/lib/hipe/ppc/hipe_ppc_ra_naive.erl index f0ca41b49e..24995be252 100644 --- a/lib/hipe/ppc/hipe_ppc_ra_naive.erl +++ b/lib/hipe/ppc/hipe_ppc_ra_naive.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/ppc/hipe_ppc_ra_postconditions.erl b/lib/hipe/ppc/hipe_ppc_ra_postconditions.erl index 142bce39cc..0b16ec3891 100644 --- a/lib/hipe/ppc/hipe_ppc_ra_postconditions.erl +++ b/lib/hipe/ppc/hipe_ppc_ra_postconditions.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/ppc/hipe_ppc_ra_postconditions_fp.erl b/lib/hipe/ppc/hipe_ppc_ra_postconditions_fp.erl index 889c5681ac..821aa66c11 100644 --- a/lib/hipe/ppc/hipe_ppc_ra_postconditions_fp.erl +++ b/lib/hipe/ppc/hipe_ppc_ra_postconditions_fp.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/ppc/hipe_ppc_registers.erl b/lib/hipe/ppc/hipe_ppc_registers.erl index 74aeab3df4..f4781d5ed7 100644 --- a/lib/hipe/ppc/hipe_ppc_registers.erl +++ b/lib/hipe/ppc/hipe_ppc_registers.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/ppc/hipe_rtl_to_ppc.erl b/lib/hipe/ppc/hipe_rtl_to_ppc.erl index 7dfa56df29..a994659616 100644 --- a/lib/hipe/ppc/hipe_rtl_to_ppc.erl +++ b/lib/hipe/ppc/hipe_rtl_to_ppc.erl @@ -2,18 +2,19 @@ %%% %%% %CopyrightBegin% %%% -%%% Copyright Ericsson AB 2004-2011. All Rights Reserved. +%%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %%% -%%% The contents of this file are subject to the Erlang Public License, -%%% Version 1.1, (the "License"); you may not use this file except in -%%% compliance with the License. You should have received a copy of the -%%% Erlang Public License along with this software. If not, it can be -%%% retrieved online at http://www.erlang.org/. +%%% Licensed under the Apache License, Version 2.0 (the "License"); +%%% you may not use this file except in compliance with the License. +%%% You may obtain a copy of the License at %%% -%%% Software distributed under the License is distributed on an "AS IS" -%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%%% the License for the specific language governing rights and limitations -%%% under the License. +%%% http://www.apache.org/licenses/LICENSE-2.0 +%%% +%%% Unless required by applicable law or agreed to in writing, software +%%% distributed under the License is distributed on an "AS IS" BASIS, +%%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%%% See the License for the specific language governing permissions and +%%% limitations under the License. %%% %%% %CopyrightEnd% %%% @@ -102,10 +103,18 @@ conv_insn(I, Map, Data) -> end. conv_fconv(I, Map, Data) -> - %% Dst := (double)Src, where Dst is FP reg and Src is int reg + %% Dst := (double)Src, where Dst is FP reg and Src is GP reg or imm {Dst, Map0} = conv_fpreg(hipe_rtl:fconv_dst(I), Map), - {Src, Map1} = conv_src(hipe_rtl:fconv_src(I), Map0), % exclude imm src - I2 = mk_fconv(Dst, Src), + {Src, Map1} = conv_src(hipe_rtl:fconv_src(I), Map0), + I2 = + case hipe_ppc:is_temp(Src) of + true -> + mk_fconv(Dst, Src); + false -> + Tmp = new_untagged_temp(), + mk_li(Tmp, Src, + mk_fconv(Dst, Tmp)) + end, {I2, Map1, Data}. mk_fconv(Dst, Src) -> diff --git a/lib/hipe/regalloc/Makefile b/lib/hipe/regalloc/Makefile index d4be79ea85..aaa4418f37 100644 --- a/lib/hipe/regalloc/Makefile +++ b/lib/hipe/regalloc/Makefile @@ -1,18 +1,19 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2001-2012. All Rights Reserved. +# Copyright Ericsson AB 2001-2016. All Rights Reserved. # -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at # -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. # # %CopyrightEnd% # @@ -76,7 +77,7 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += +warn_exported_vars# +warn_missing_spec +warn_untyped_record +ERL_COMPILE_FLAGS += -Werror +warn_export_vars #+warn_missing_spec +warn_untyped_record # ---------------------------------------------------- # Targets diff --git a/lib/hipe/regalloc/hipe_adj_list.erl b/lib/hipe/regalloc/hipe_adj_list.erl index b55b22cb22..de59da2410 100644 --- a/lib/hipe/regalloc/hipe_adj_list.erl +++ b/lib/hipe/regalloc/hipe_adj_list.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/regalloc/hipe_amd64_specific.erl b/lib/hipe/regalloc/hipe_amd64_specific.erl index 91a8c7253a..6937e71ac7 100644 --- a/lib/hipe/regalloc/hipe_amd64_specific.erl +++ b/lib/hipe/regalloc/hipe_amd64_specific.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/regalloc/hipe_amd64_specific_sse2.erl b/lib/hipe/regalloc/hipe_amd64_specific_sse2.erl index 5654455b44..50e5869d45 100644 --- a/lib/hipe/regalloc/hipe_amd64_specific_sse2.erl +++ b/lib/hipe/regalloc/hipe_amd64_specific_sse2.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/regalloc/hipe_amd64_specific_x87.erl b/lib/hipe/regalloc/hipe_amd64_specific_x87.erl index b5e8253ae1..2160e93d24 100644 --- a/lib/hipe/regalloc/hipe_amd64_specific_x87.erl +++ b/lib/hipe/regalloc/hipe_amd64_specific_x87.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/regalloc/hipe_arm_specific.erl b/lib/hipe/regalloc/hipe_arm_specific.erl index 246095e926..4e34cb1d99 100644 --- a/lib/hipe/regalloc/hipe_arm_specific.erl +++ b/lib/hipe/regalloc/hipe_arm_specific.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/regalloc/hipe_coalescing_regalloc.erl b/lib/hipe/regalloc/hipe_coalescing_regalloc.erl index 7169dd18f3..e2f817d369 100644 --- a/lib/hipe/regalloc/hipe_coalescing_regalloc.erl +++ b/lib/hipe/regalloc/hipe_coalescing_regalloc.erl @@ -1,19 +1,20 @@ -%% -*- coding: utf-8; erlang-indent-level: 2 -*- +%% -*- erlang-indent-level: 2 -*- %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2012. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/regalloc/hipe_graph_coloring_regalloc.erl b/lib/hipe/regalloc/hipe_graph_coloring_regalloc.erl index 6ba4ac814e..bc6e442236 100644 --- a/lib/hipe/regalloc/hipe_graph_coloring_regalloc.erl +++ b/lib/hipe/regalloc/hipe_graph_coloring_regalloc.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2011. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/regalloc/hipe_ig.erl b/lib/hipe/regalloc/hipe_ig.erl index 4991e73e53..8fd5d0df1f 100644 --- a/lib/hipe/regalloc/hipe_ig.erl +++ b/lib/hipe/regalloc/hipe_ig.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/regalloc/hipe_ig_moves.erl b/lib/hipe/regalloc/hipe_ig_moves.erl index 186c87a690..b679453de0 100644 --- a/lib/hipe/regalloc/hipe_ig_moves.erl +++ b/lib/hipe/regalloc/hipe_ig_moves.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -36,7 +37,7 @@ -record(ig_moves, {movelist :: hipe_vector(), nrmoves = 0 :: non_neg_integer(), moveinsns = [] :: [{_,_}], - moveset = gb_sets:empty() :: gb_set()}). + moveset = gb_sets:empty() :: gb_sets:set()}). %%----------------------------------------------------------------------------- diff --git a/lib/hipe/regalloc/hipe_ls_regalloc.erl b/lib/hipe/regalloc/hipe_ls_regalloc.erl index 4276b8f968..d24b803524 100644 --- a/lib/hipe/regalloc/hipe_ls_regalloc.erl +++ b/lib/hipe/regalloc/hipe_ls_regalloc.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -722,7 +723,7 @@ is_free(R, Free) -> is_free(R, Free, []). is_free(R, [{R,_}|Rest], Acc) -> - {true,lists:reverse(Acc)++Rest}; + {true, lists:reverse(Acc, Rest)}; is_free(R, [X|Rs],Acc) -> is_free(R, Rs, [X|Acc]); is_free(_, [], _) -> @@ -733,7 +734,7 @@ exists_free_register(Start, Regs) -> exists_free_register(Start, [{Phys, Start0}|Rest], Acc) when Start > Start0 -> - {true, Phys, lists:reverse(Acc)++Rest}; + {true, Phys, lists:reverse(Acc, Rest)}; exists_free_register(Start, [Free|Rest], Acc) -> exists_free_register(Start, Rest, [Free|Acc]); exists_free_register(_, [], _) -> diff --git a/lib/hipe/regalloc/hipe_moves.erl b/lib/hipe/regalloc/hipe_moves.erl index afec4aa4ce..39ccfb4a2f 100644 --- a/lib/hipe/regalloc/hipe_moves.erl +++ b/lib/hipe/regalloc/hipe_moves.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/regalloc/hipe_node_sets.erl b/lib/hipe/regalloc/hipe_node_sets.erl index be43ff2bfd..01922a34d4 100644 --- a/lib/hipe/regalloc/hipe_node_sets.erl +++ b/lib/hipe/regalloc/hipe_node_sets.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2011. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/regalloc/hipe_optimistic_regalloc.erl b/lib/hipe/regalloc/hipe_optimistic_regalloc.erl index fc3718cbc0..2ed9ec3b45 100644 --- a/lib/hipe/regalloc/hipe_optimistic_regalloc.erl +++ b/lib/hipe/regalloc/hipe_optimistic_regalloc.erl @@ -1,19 +1,20 @@ -%% -*- coding: utf-8; erlang-indent-level: 2 -*- +%% -*- erlang-indent-level: 2 -*- %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2012. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -958,9 +959,9 @@ splits_2({Cols, NonCols, OldSpillCost}, L, SpillCost) -> %% Merge two ordered sub-splits into one. spillCostOrderedMerge(Spl1, [], Spl) -> - lists:reverse(Spl) ++ Spl1; + lists:reverse(Spl, Spl1); spillCostOrderedMerge([], Spl2, Spl) -> - lists:reverse(Spl) ++ Spl2; + lists:reverse(Spl, Spl2); spillCostOrderedMerge(Spl1, Spl2, Spl) -> {_, _, SpillCost1} = hd(Spl1), {_, _, SpillCost2} = hd(Spl2), diff --git a/lib/hipe/regalloc/hipe_ppc_specific.erl b/lib/hipe/regalloc/hipe_ppc_specific.erl index dd2855208b..c49b1e510f 100644 --- a/lib/hipe/regalloc/hipe_ppc_specific.erl +++ b/lib/hipe/regalloc/hipe_ppc_specific.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/regalloc/hipe_ppc_specific_fp.erl b/lib/hipe/regalloc/hipe_ppc_specific_fp.erl index 35623e7994..454aa4c686 100644 --- a/lib/hipe/regalloc/hipe_ppc_specific_fp.erl +++ b/lib/hipe/regalloc/hipe_ppc_specific_fp.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/regalloc/hipe_reg_worklists.erl b/lib/hipe/regalloc/hipe_reg_worklists.erl index e22cc8dc07..88585f9f38 100644 --- a/lib/hipe/regalloc/hipe_reg_worklists.erl +++ b/lib/hipe/regalloc/hipe_reg_worklists.erl @@ -1,19 +1,20 @@ -%%% -*- coding: utf-8; erlang-indent-level: 2 -*- +%%% -*- erlang-indent-level: 2 -*- %%% %%% %CopyrightBegin% %%% -%%% Copyright Ericsson AB 2001-2012. All Rights Reserved. +%%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %%% -%%% The contents of this file are subject to the Erlang Public License, -%%% Version 1.1, (the "License"); you may not use this file except in -%%% compliance with the License. You should have received a copy of the -%%% Erlang Public License along with this software. If not, it can be -%%% retrieved online at http://www.erlang.org/. -%%% -%%% Software distributed under the License is distributed on an "AS IS" -%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%%% the License for the specific language governing rights and limitations -%%% under the License. +%%% Licensed under the Apache License, Version 2.0 (the "License"); +%%% you may not use this file except in compliance with the License. +%%% You may obtain a copy of the License at +%%% +%%% http://www.apache.org/licenses/LICENSE-2.0 +%%% +%%% Unless required by applicable law or agreed to in writing, software +%%% distributed under the License is distributed on an "AS IS" BASIS, +%%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%%% See the License for the specific language governing permissions and +%%% limitations under the License. %%% %%% %CopyrightEnd% %%% diff --git a/lib/hipe/regalloc/hipe_regalloc_loop.erl b/lib/hipe/regalloc/hipe_regalloc_loop.erl index 428a82c87b..d29615a3a0 100644 --- a/lib/hipe/regalloc/hipe_regalloc_loop.erl +++ b/lib/hipe/regalloc/hipe_regalloc_loop.erl @@ -2,18 +2,19 @@ %%% %%% %CopyrightBegin% %%% -%%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %%% -%%% The contents of this file are subject to the Erlang Public License, -%%% Version 1.1, (the "License"); you may not use this file except in -%%% compliance with the License. You should have received a copy of the -%%% Erlang Public License along with this software. If not, it can be -%%% retrieved online at http://www.erlang.org/. -%%% -%%% Software distributed under the License is distributed on an "AS IS" -%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%%% the License for the specific language governing rights and limitations -%%% under the License. +%%% Licensed under the Apache License, Version 2.0 (the "License"); +%%% you may not use this file except in compliance with the License. +%%% You may obtain a copy of the License at +%%% +%%% http://www.apache.org/licenses/LICENSE-2.0 +%%% +%%% Unless required by applicable law or agreed to in writing, software +%%% distributed under the License is distributed on an "AS IS" BASIS, +%%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%%% See the License for the specific language governing permissions and +%%% limitations under the License. %%% %%% %CopyrightEnd% %%% diff --git a/lib/hipe/regalloc/hipe_sparc_specific.erl b/lib/hipe/regalloc/hipe_sparc_specific.erl index 7b8c62e802..8d34604f84 100644 --- a/lib/hipe/regalloc/hipe_sparc_specific.erl +++ b/lib/hipe/regalloc/hipe_sparc_specific.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/regalloc/hipe_sparc_specific_fp.erl b/lib/hipe/regalloc/hipe_sparc_specific_fp.erl index 8a27f84e67..2edd3cb47e 100644 --- a/lib/hipe/regalloc/hipe_sparc_specific_fp.erl +++ b/lib/hipe/regalloc/hipe_sparc_specific_fp.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% Copyright Ericsson AB 2002-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/regalloc/hipe_spillcost.erl b/lib/hipe/regalloc/hipe_spillcost.erl index 04b25f6339..b241e637d9 100644 --- a/lib/hipe/regalloc/hipe_spillcost.erl +++ b/lib/hipe/regalloc/hipe_spillcost.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/regalloc/hipe_spillcost.hrl b/lib/hipe/regalloc/hipe_spillcost.hrl index e736a561d7..3cadcbe432 100644 --- a/lib/hipe/regalloc/hipe_spillcost.hrl +++ b/lib/hipe/regalloc/hipe_spillcost.hrl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2009. All Rights Reserved. +%% Copyright Ericsson AB 2009-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/regalloc/hipe_temp_map.erl b/lib/hipe/regalloc/hipe_temp_map.erl index 85678edd54..4085a0e1a7 100644 --- a/lib/hipe/regalloc/hipe_temp_map.erl +++ b/lib/hipe/regalloc/hipe_temp_map.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/regalloc/hipe_x86_specific.erl b/lib/hipe/regalloc/hipe_x86_specific.erl index 0f490ba14d..4edf8674b7 100644 --- a/lib/hipe/regalloc/hipe_x86_specific.erl +++ b/lib/hipe/regalloc/hipe_x86_specific.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/regalloc/hipe_x86_specific_x87.erl b/lib/hipe/regalloc/hipe_x86_specific_x87.erl index 7fd80b63d8..ece07cb2f9 100644 --- a/lib/hipe/regalloc/hipe_x86_specific_x87.erl +++ b/lib/hipe/regalloc/hipe_x86_specific_x87.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2009. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/rtl/Makefile b/lib/hipe/rtl/Makefile index 751e87636a..b4cdf8b1f2 100644 --- a/lib/hipe/rtl/Makefile +++ b/lib/hipe/rtl/Makefile @@ -1,18 +1,19 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2001-2013. All Rights Reserved. +# Copyright Ericsson AB 2001-2016. All Rights Reserved. # -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at # -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. # # %CopyrightEnd% # @@ -74,7 +75,7 @@ TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) include ../native.mk -ERL_COMPILE_FLAGS += +inline +warn_unused_import +warn_exported_vars +ERL_COMPILE_FLAGS += -Werror +inline +warn_unused_import +warn_export_vars # ---------------------------------------------------- # Targets diff --git a/lib/hipe/rtl/hipe_icode2rtl.erl b/lib/hipe/rtl/hipe_icode2rtl.erl index 034153a3cb..22feca47cc 100644 --- a/lib/hipe/rtl/hipe_icode2rtl.erl +++ b/lib/hipe/rtl/hipe_icode2rtl.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -427,8 +428,6 @@ gen_type_test([X], Type, TrueLbl, FalseLbl, Pred, ConstTab) -> hipe_rtl:mk_branch(X, eq, TmpF, TrueLbl, FalseLbl, Pred)], ConstTab}; cons -> {hipe_tagscheme:test_cons(X, TrueLbl, FalseLbl, Pred), ConstTab}; - constant -> - {hipe_tagscheme:test_constant(X, TrueLbl, FalseLbl, Pred), ConstTab}; fixnum -> {hipe_tagscheme:test_fixnum(X, TrueLbl, FalseLbl, Pred), ConstTab}; float -> @@ -439,6 +438,8 @@ gen_type_test([X], Type, TrueLbl, FalseLbl, Pred, ConstTab) -> {hipe_tagscheme:test_integer(X, TrueLbl, FalseLbl, Pred), ConstTab}; list -> {hipe_tagscheme:test_list(X, TrueLbl, FalseLbl, Pred), ConstTab}; + map -> + {hipe_tagscheme:test_map(X, TrueLbl, FalseLbl, Pred), ConstTab}; nil -> {hipe_tagscheme:test_nil(X, TrueLbl, FalseLbl, Pred), ConstTab}; number -> diff --git a/lib/hipe/rtl/hipe_rtl.erl b/lib/hipe/rtl/hipe_rtl.erl index 4bf4eb6bd7..0726827299 100644 --- a/lib/hipe/rtl/hipe_rtl.erl +++ b/lib/hipe/rtl/hipe_rtl.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2011. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -29,7 +30,7 @@ %% <li> {alu, Dst, Src1, Op, Src2} </li> %% <li> {alub, Dst, Src1, Op, Src2, RelOp, TrueLabel, FalseLabel, P} </li> %% <li> {branch, Src1, Src2, RelOp, TrueLabel, FalseLabel, P} </li> -%% <li> {call, DsListt, Fun, ArgList, Type, Continuation, FailContinuation} +%% <li> {call, DsListt, Fun, ArgList, Type, Continuation, FailContinuation, NormalContinuation} %% Type is one of {local, remote, primop, closure} </li> %% <li> {comment, Text} </li> %% <li> {enter, Fun, ArgList, Type} @@ -106,7 +107,7 @@ %% rtl_data_update/2, %% rtl_var_range/1, %% rtl_var_range_update/2, - %% rtl_label_range/1, + rtl_label_range/1, %% rtl_label_range_update/2, rtl_info/1, rtl_info_update/2]). @@ -226,6 +227,7 @@ %% goto_label_update/2, mk_call/6, + mk_call/7, call_fun/1, call_dstlist/1, call_dstlist_update/2, @@ -233,8 +235,10 @@ call_continuation/1, call_fail/1, call_type/1, + call_normal/1, + call_normal_update/2, %% call_continuation_update/2, - %% call_fail_update/2, + call_fail_update/2, is_call/1, mk_enter/3, @@ -290,10 +294,13 @@ %% fconv_src_update/2, %% is_fconv/1, - %% mk_var/1, + mk_var/1, + mk_var/2, mk_new_var/0, is_var/1, var_index/1, + var_liveness/1, + var_liveness_update/2, %% change_vars_to_regs/1, @@ -350,11 +357,16 @@ %% move_dst_update/2, fixnumop_dst_update/2, pp_instr/2, - %% pp_arg/2, + %% Uber hack! + pp_var/2, + pp_reg/2, + pp_arg/2, phi_arglist_update/2, phi_redirect_pred/3]). --export_type([alub_cond/0]). +-export([subst_uses_llvm/2]). + +-export_type([alub_cond/0, rtl/0]). %% %% RTL @@ -372,6 +384,7 @@ label_range, %% {Min,Max} First and last name used for labels info=[] %% A keylist with arbitrary information. }). +-opaque rtl() :: #rtl{}. mk_rtl(Fun, ArgList, Closure, Leaf, Code, Data, VarRange, LabelRange) -> #rtl{'fun'=Fun, arglist=ArgList, code=Code, @@ -387,7 +400,7 @@ rtl_data(#rtl{data=Data}) -> Data. %% rtl_data_update(Rtl, Data) -> Rtl#rtl{data=Data}. %% rtl_var_range(#rtl{var_range=VarRange}) -> VarRange. %% rtl_var_range_update(Rtl, VarRange) -> Rtl#rtl{var_range=VarRange}. -%% rtl_label_range(#rtl{label_range=LabelRange}) -> LabelRange. +rtl_label_range(#rtl{label_range=LabelRange}) -> LabelRange. %% rtl_label_range_update(Rtl, LabelRange) -> Rtl#rtl{label_range=LabelRange}. rtl_info(#rtl{info=Info}) -> Info. rtl_info_update(Rtl, Info) -> Rtl#rtl{info=Info}. @@ -402,11 +415,13 @@ rtl_info_update(Rtl, Info) -> Rtl#rtl{info=Info}. %% move %% -mk_move(Dst, Src) -> #move{dst=Dst, src=Src}. +mk_move(Dst, Src) -> + false = is_fpreg(Dst), false = is_fpreg(Src), + #move{dst=Dst, src=Src}. move_dst(#move{dst=Dst}) -> Dst. -move_dst_update(M, NewDst) -> M#move{dst=NewDst}. +move_dst_update(M, NewDst) -> false = is_fpreg(NewDst), M#move{dst=NewDst}. move_src(#move{src=Src}) -> Src. -move_src_update(M, NewSrc) -> M#move{src=NewSrc}. +move_src_update(M, NewSrc) -> false = is_fpreg(NewSrc), M#move{src=NewSrc}. %% is_move(#move{}) -> true; %% is_move(_) -> false. @@ -458,7 +473,11 @@ phi_remove_pred(Phi, Pred) -> case NewArgList of [Arg] -> %% the phi should be turned into a move instruction {_Label,Var} = Arg, - mk_move(phi_dst(Phi), Var); + Dst = phi_dst(Phi), + case {is_fpreg(Dst), is_fpreg(Var)} of + {true, true} -> mk_fmove(Dst, Var); + {false, false} -> mk_move(Dst, Var) + end; %% io:format("~nPhi (~w) turned into move (~w) when removing pred ~w~n",[Phi,Move,Pred]), [_|_] -> Phi#phi{arglist=NewArgList} @@ -643,6 +662,17 @@ is_goto(_) -> false. %% call %% +%% LLVM: Call with normal continuation +mk_call(DstList, Fun, ArgList, Continuation, FailContinuation, + NormalContinuation, Type) -> + case Type of + remote -> ok; + not_remote -> ok + end, + #call{dstlist=DstList, 'fun'=Fun, arglist=ArgList, type=Type, + continuation=Continuation, failcontinuation=FailContinuation, + normalcontinuation=NormalContinuation}. + mk_call(DstList, Fun, ArgList, Continuation, FailContinuation, Type) -> case Type of remote -> ok; @@ -651,6 +681,10 @@ mk_call(DstList, Fun, ArgList, Continuation, FailContinuation, Type) -> #call{dstlist=DstList, 'fun'=Fun, arglist=ArgList, type=Type, continuation=Continuation, failcontinuation=FailContinuation}. + +call_normal(#call{normalcontinuation=NormalContinuation}) -> NormalContinuation. +call_normal_update(C, NewNormalContinuation) -> + C#call{normalcontinuation=NewNormalContinuation}. call_dstlist(#call{dstlist=DstList}) -> DstList. call_dstlist_update(C, NewDstList) -> C#call{dstlist=NewDstList}. call_fun(#call{'fun'=Fun}) -> Fun. @@ -810,11 +844,11 @@ fp_unop_op(#fp_unop{op=Op}) -> Op. %% fmove %% -mk_fmove(X, Y) -> #fmove{dst=X, src=Y}. +mk_fmove(X, Y) -> true = is_fpreg(X), true = is_fpreg(Y), #fmove{dst=X, src=Y}. fmove_dst(#fmove{dst=Dst}) -> Dst. -fmove_dst_update(M, NewDst) -> M#fmove{dst=NewDst}. +fmove_dst_update(M, NewDst) -> true = is_fpreg(NewDst), M#fmove{dst=NewDst}. fmove_src(#fmove{src=Src}) -> Src. -fmove_src_update(M, NewSrc) -> M#fmove{src=NewSrc}. +fmove_src_update(M, NewSrc) -> true = is_fpreg(NewSrc), M#fmove{src=NewSrc}. %% %% fconv @@ -853,11 +887,14 @@ reg_is_gcsafe(#rtl_reg{is_gc_safe=IsGcSafe}) -> IsGcSafe. is_reg(#rtl_reg{}) -> true; is_reg(_) -> false. --record(rtl_var, {index :: non_neg_integer()}). +-record(rtl_var, {index :: non_neg_integer(), liveness=live :: dead | live}). mk_var(Num) when is_integer(Num), Num >= 0 -> #rtl_var{index=Num}. +mk_var(Num, Liveness) when is_integer(Num), Num>=0 -> #rtl_var{index=Num, liveness=Liveness}. mk_new_var() -> mk_var(hipe_gensym:get_next_var(rtl)). var_index(#rtl_var{index=Index}) -> Index. +var_liveness(#rtl_var{liveness=Liveness}) -> Liveness. +var_liveness_update(RtlVar, Liveness) -> RtlVar#rtl_var{liveness=Liveness}. is_var(#rtl_var{}) -> true; is_var(_) -> false. @@ -1077,6 +1114,131 @@ subst_uses(Subst, I) -> switch_src_update(I, subst1(Subst, switch_src(I))) end. +subst_uses_llvm(Subst, I) -> + case I of + #alu{} -> + {NewSrc2, Subst1} = subst1_llvm(Subst, alu_src2(I)), + {NewSrc1, _ } = subst1_llvm(Subst1, alu_src1(I)), + I0 = alu_src1_update(I, NewSrc1), + alu_src2_update(I0, NewSrc2); + #alub{} -> + {NewSrc2, Subst1} = subst1_llvm(Subst, alub_src2(I)), + {NewSrc1, _ } = subst1_llvm(Subst1, alub_src1(I)), + I0 = alub_src1_update(I, NewSrc1), + alub_src2_update(I0, NewSrc2); + #branch{} -> + {NewSrc2, Subst1} = subst1_llvm(Subst, branch_src2(I)), + {NewSrc1, _ } = subst1_llvm(Subst1, branch_src1(I)), + I0 = branch_src1_update(I, NewSrc1), + branch_src2_update(I0, NewSrc2); + #call{} -> + case call_is_known(I) of + false -> + {NewFun, Subst1} = subst1_llvm(Subst, call_fun(I)), + {NewArgList, _} = subst_list_llvm(Subst1, call_arglist(I)), + I0 = call_fun_update(I, NewFun), + call_arglist_update(I0, NewArgList); + true -> + {NewArgList, _} = subst_list_llvm(Subst, call_arglist(I)), + call_arglist_update(I, NewArgList) + end; + #comment{} -> + I; + #enter{} -> + case enter_is_known(I) of + false -> + {NewFun, Subst1} = subst1_llvm(Subst, enter_fun(I)), + {NewArgList, _} = subst_list_llvm(Subst1, enter_arglist(I)), + I0 = enter_fun_update(I, NewFun), + enter_arglist_update(I0, NewArgList); + true -> + {NewArgList, _} = subst_list_llvm(Subst, enter_arglist(I)), + enter_arglist_update(I, NewArgList) + end; + #fconv{} -> + {NewSrc, _ } = subst1_llvm(Subst, fconv_src(I)), + fconv_src_update(I, NewSrc); + #fixnumop{} -> + {NewSrc, _ } = subst1_llvm(Subst, fixnumop_src(I)), + fixnumop_src_update(I, NewSrc); + #fload{} -> + {NewSrc, Subst1} = subst1_llvm(Subst, fload_src(I)), + {NewOffset, _ } = subst1_llvm(Subst1, fload_offset(I)), + I0 = fload_src_update(I, NewSrc), + fload_offset_update(I0, NewOffset); + #fmove{} -> + {NewSrc, _ } = subst1_llvm(Subst, fmove_src(I)), + fmove_src_update(I, NewSrc); + #fp{} -> + {NewSrc2, Subst1} = subst1_llvm(Subst, fp_src2(I)), + {NewSrc1, _ } = subst1_llvm(Subst1, fp_src1(I)), + I0 = fp_src1_update(I, NewSrc1), + fp_src2_update(I0, NewSrc2); + #fp_unop{} -> + {NewSrc, _ } = subst1_llvm(Subst, fp_unop_src(I)), + fp_unop_src_update(I, NewSrc); + #fstore{} -> + {NewSrc, Subst1} = subst1_llvm(Subst, fstore_src(I)), + {NewBase, Subst2} = subst1_llvm(Subst1, fstore_base(I)), + {NewOffset, _ } = subst1_llvm(Subst2, fstore_offset(I)), + I0 = fstore_src_update(I, NewSrc), + I1 = fstore_base_update(I0, NewBase), + fstore_offset_update(I1, NewOffset); + #goto{} -> + I; + #goto_index{} -> + I; + #gctest{} -> + {NewWords, _ } = subst1_llvm(Subst, gctest_words(I)), + gctest_words_update(I, NewWords); + #label{} -> + I; + #load{} -> + {NewSrc, Subst1} = subst1_llvm(Subst, load_src(I)), + {NewOffset, _ } = subst1_llvm(Subst1, load_offset(I)), + I0 = load_src_update(I, NewSrc), + load_offset_update(I0, NewOffset); + #load_address{} -> + I; + #load_atom{} -> + I; + #load_word_index{} -> + I; + #move{} -> + {NewSrc, _ } = subst1_llvm(Subst, move_src(I)), + move_src_update(I, NewSrc); + #multimove{} -> + {NewSrcList, _} = subst_list_llvm(Subst, multimove_srclist(I)), + multimove_srclist_update(I, NewSrcList); + #phi{} -> + phi_argvar_subst(I, Subst); + #return{} -> + {NewVarList, _} = subst_list_llvm(Subst, return_varlist(I)), + return_varlist_update(I, NewVarList); + #store{} -> + {NewSrc, Subst1} = subst1_llvm(Subst, store_src(I)), + {NewBase, Subst2} = subst1_llvm(Subst1, store_base(I)), + {NewOffset, _ } = subst1_llvm(Subst2, store_offset(I)), + I0 = store_src_update(I, NewSrc), + I1 = store_base_update(I0, NewBase), + store_offset_update(I1, NewOffset); + #switch{} -> + {NewSrc, _ } = subst1_llvm(Subst, switch_src(I)), + switch_src_update(I, NewSrc) + end. + +subst_list_llvm(S,X) -> subst_list_llvm(S, lists:reverse(X), []). +subst_list_llvm(S, [], Acc) -> {Acc, S}; +subst_list_llvm(S, [X|Xs], Acc) -> + {NewX, RestS} = subst1_llvm(S, X), + subst_list_llvm(RestS, Xs, [NewX|Acc]). + +subst1_llvm(A,B) -> subst1_llvm(A,B,[]). + +subst1_llvm([], X, Acc) -> {X, Acc}; +subst1_llvm([{X,Y}|Rs], X, Acc) -> {Y, Acc++Rs}; +subst1_llvm([R|Xs], X, Acc) -> subst1_llvm(Xs,X,[R|Acc]). + subst_defines(Subst, I)-> case I of #alu{} -> @@ -1614,7 +1776,11 @@ pp_var(Dev, Arg) -> true -> pp_hard_reg(Dev, var_index(Arg)); false -> - io:format(Dev, "v~w", [var_index(Arg)]) + io:format(Dev, "v~w", [var_index(Arg)]), + case var_liveness(Arg) of + dead -> io:format(Dev, "(dead)", []); + _ -> ok + end end. pp_arg(Dev, A) -> diff --git a/lib/hipe/rtl/hipe_rtl.hrl b/lib/hipe/rtl/hipe_rtl.hrl index 974e40f830..cc76e7e5c4 100644 --- a/lib/hipe/rtl/hipe_rtl.hrl +++ b/lib/hipe/rtl/hipe_rtl.hrl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -28,7 +29,8 @@ -record(alu, {dst, src1, op, src2}). -record(alub, {dst, src1, op, src2, 'cond', true_label, false_label, p}). -record(branch, {src1, src2, 'cond', true_label, false_label, p}). --record(call, {dstlist, 'fun', arglist, type, continuation, failcontinuation}). +-record(call, {dstlist, 'fun', arglist, type, continuation, + failcontinuation, normalcontinuation = []}). -record(comment, {text}). -record(enter, {'fun', arglist, type}). -record(fconv, {dst, src}). diff --git a/lib/hipe/rtl/hipe_rtl_arch.erl b/lib/hipe/rtl/hipe_rtl_arch.erl index 99eb80f3d1..397b96120e 100644 --- a/lib/hipe/rtl/hipe_rtl_arch.erl +++ b/lib/hipe/rtl/hipe_rtl_arch.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2011. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/rtl/hipe_rtl_arith.inc b/lib/hipe/rtl/hipe_rtl_arith.inc index 7b587e882d..0c396c8e76 100644 --- a/lib/hipe/rtl/hipe_rtl_arith.inc +++ b/lib/hipe/rtl/hipe_rtl_arith.inc @@ -1,20 +1,21 @@ %% -*- Erlang -*- -%% -*- coding: utf-8; erlang-indent-level: 2 -*- +%% -*- erlang-indent-level: 2 -*- %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2012. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -29,13 +30,13 @@ %% Returns a tuple %% {Res, Sign, Zero, Overflow, Carry} %% Res will be a number in the range -%% MAX_SIGNED_INT >= Res >= MIN_SIGNED_INT +%% MAX_UNSIGNED_INT >= Res >= 0 %% The other four values are flags that are either true or false %% eval_alu(Op, Arg1, Arg2) - when Arg1 =< ?MAX_SIGNED_INT, + when Arg1 =< ?MAX_UNSIGNED_INT, Arg1 >= ?MIN_SIGNED_INT, - Arg2 =< ?MAX_SIGNED_INT, + Arg2 =< ?MAX_UNSIGNED_INT, Arg2 >= ?MIN_SIGNED_INT -> Sign1 = sign_bit(Arg1), @@ -46,73 +47,80 @@ eval_alu(Op, Arg1, Arg2) Res = (Arg1 - Arg2) band ?WORDMASK, N = sign_bit(Res), Z = zero(Res), - V = (Sign1 and (not Sign2) and (not N)) + V = (Sign1 andalso (not Sign2) andalso (not N)) or - ((not Sign1) and Sign2 and N), - C = ((not Sign1) and Sign2) + ((not Sign1) andalso Sign2 andalso N), + C = ((not Sign1) andalso Sign2) or - (N and ((not Sign1) or Sign2)); + (N andalso ((not Sign1) orelse Sign2)), + {Res, N, Z, V, C}; 'add' -> Res = (Arg1 + Arg2) band ?WORDMASK, N = sign_bit(Res), Z = zero(Res), - V = (Sign1 and Sign2 and (not N)) + V = (Sign1 andalso Sign2 andalso (not N)) or - ((not Sign1) and (not Sign2) and N), - C = (Sign1 and Sign2) + ((not Sign1) andalso (not Sign2) andalso N), + C = (Sign1 andalso Sign2) or - ((not N) and (Sign1 or Sign2)); + ((not N) andalso (Sign1 orelse Sign2)), + {Res, N, Z, V, C}; 'mul' -> FullRes = Arg1 * Arg2, Res = FullRes band ?WORDMASK, ResHi = FullRes bsr ?BITS, N = sign_bit(Res), Z = zero(Res), - V = (N and (ResHi =/= -1)) or ((not N) and (ResHi =/= 0)), - C = V; + V = (N andalso (ResHi =/= -1)) orelse ((not N) andalso (ResHi =/= 0)), + C = V, + {Res, N, Z, V, C}; 'sra' -> Res = (Arg1 bsr Arg2) band ?WORDMASK, N = sign_bit(Res), Z = zero(Res), V = 0, - C = 0; + C = 0, + {Res, N, Z, V, C}; 'srl' -> Res = (Arg1 bsr Arg2) band shiftmask(Arg2), N = sign_bit(Res), Z = zero(Res), V = 0, - C = 0; + C = 0, + {Res, N, Z, V, C}; 'sll' -> Res = (Arg1 bsl Arg2) band ?WORDMASK, N = sign_bit(Res), Z = zero(Res), V = 0, - C = 0; + C = 0, + {Res, N, Z, V, C}; 'or' -> Res = (Arg1 bor Arg2) band ?WORDMASK, N = sign_bit(Res), Z = zero(Res), V = 0, - C = 0; + C = 0, + {Res, N, Z, V, C}; 'and' -> Res = (Arg1 band Arg2) band ?WORDMASK, N = sign_bit(Res), Z = zero(Res), V = 0, - C = 0; + C = 0, + {Res, N, Z, V, C}; 'xor' -> Res = (Arg1 bxor Arg2) band ?WORDMASK, N = sign_bit(Res), Z = zero(Res), V = 0, - C = 0; + C = 0, + {Res, N, Z, V, C}; Op -> - Res = N = Z = V = C = 0, ?EXIT({"unknown alu op", Op}) - end, - {two_comp_to_erl(Res), N, Z, V, C}; + end; eval_alu(Op, Arg1, Arg2) -> - ?EXIT({argument_overflow,Op,Arg1,Arg2}). + ?EXIT({argument_overflow, Op, Arg1, Arg2}). %% Björn & Bjarni: %% We need to be able to do evaluations based only on the bits, since @@ -129,9 +137,9 @@ eval_cond_bits(Cond, N, Z, V, C) -> 'ne' -> not Z; 'gt' -> - not (Z or (N xor V)); + not (Z orelse (N xor V)); 'gtu' -> - not (C or Z); + not (C orelse Z); 'ge' -> not (N xor V); 'geu'-> @@ -141,9 +149,9 @@ eval_cond_bits(Cond, N, Z, V, C) -> 'ltu'-> C; 'le' -> - Z or (N xor V); + Z orelse (N xor V); 'leu'-> - C or Z; + C orelse Z; 'overflow' -> V; 'not_overflow' -> @@ -161,16 +169,9 @@ eval_cond(Cond, Arg1, Arg2) -> sign_bit(Val) -> ((Val bsr ?SIGN_BIT) band 1) =:= 1. -two_comp_to_erl(V) -> - if V > ?MAX_SIGNED_INT -> - - ((?MAX_UNSIGNED_INT + 1) - V); - true -> V - end. - shiftmask(Arg) -> Setbits = ?BITS - Arg, (1 bsl Setbits) - 1. zero(Val) -> Val =:= 0. - diff --git a/lib/hipe/rtl/hipe_rtl_arith_32.erl b/lib/hipe/rtl/hipe_rtl_arith_32.erl index a8a6043cda..12075ed609 100644 --- a/lib/hipe/rtl/hipe_rtl_arith_32.erl +++ b/lib/hipe/rtl/hipe_rtl_arith_32.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2003-2009. All Rights Reserved. +%% Copyright Ericsson AB 2003-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -23,7 +24,8 @@ %% Filename : hipe_rtl_arith_32.erl %% Module : hipe_rtl_arith_32 %% Purpose : To implement 32-bit RTL-arithmetic -%% Notes : The arithmetic works on 32-bit signed integers. +%% Notes : The arithmetic works on 32-bit signed and unsigned +%% integers. %% The implementation is taken from the implementation %% of arithmetic on SPARC. %% XXX: This code is seldom used, and hence also diff --git a/lib/hipe/rtl/hipe_rtl_arith_64.erl b/lib/hipe/rtl/hipe_rtl_arith_64.erl index d0d576b65e..6dac8fb145 100644 --- a/lib/hipe/rtl/hipe_rtl_arith_64.erl +++ b/lib/hipe/rtl/hipe_rtl_arith_64.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/rtl/hipe_rtl_binary.erl b/lib/hipe/rtl/hipe_rtl_binary.erl index 5ea51acedb..fb9c0c196d 100644 --- a/lib/hipe/rtl/hipe_rtl_binary.erl +++ b/lib/hipe/rtl/hipe_rtl_binary.erl @@ -1,18 +1,20 @@ +%% -*- erlang-indent-level: 2 -*- %%% %%% %CopyrightBegin% %%% -%%% Copyright Ericsson AB 2006-2009. All Rights Reserved. +%%% Copyright Ericsson AB 2006-2016. All Rights Reserved. %%% -%%% The contents of this file are subject to the Erlang Public License, -%%% Version 1.1, (the "License"); you may not use this file except in -%%% compliance with the License. You should have received a copy of the -%%% Erlang Public License along with this software. If not, it can be -%%% retrieved online at http://www.erlang.org/. -%%% -%%% Software distributed under the License is distributed on an "AS IS" -%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%%% the License for the specific language governing rights and limitations -%%% under the License. +%%% Licensed under the Apache License, Version 2.0 (the "License"); +%%% you may not use this file except in compliance with the License. +%%% You may obtain a copy of the License at +%%% +%%% http://www.apache.org/licenses/LICENSE-2.0 +%%% +%%% Unless required by applicable law or agreed to in writing, software +%%% distributed under the License is distributed on an "AS IS" BASIS, +%%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%%% See the License for the specific language governing permissions and +%%% limitations under the License. %%% %%% %CopyrightEnd% %%% @@ -27,11 +29,20 @@ -export([gen_rtl/7]). +-export([floorlog2/1, get_word_integer/4, make_size/3, make_size/4]). + +%%-------------------------------------------------------------------- + +-define(BYTE_SHIFT, 3). %% Turn bits into bytes or vice versa +-define(BYTE_SIZE, 8). + +%%-------------------------------------------------------------------- + gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SysLimName, ConstTab) -> case type_of_operation(BsOP) of match -> {hipe_rtl_binary_match:gen_rtl( - BsOP, Dst, Args, TrueLblName, FalseLblName),ConstTab}; + BsOP, Dst, Args, TrueLblName, FalseLblName),ConstTab}; construct -> hipe_rtl_binary_construct:gen_rtl( BsOP, Dst, Args, TrueLblName, FalseLblName, SysLimName, ConstTab) @@ -61,7 +72,7 @@ type_of_operation({bs_init,_,_}) -> construct; type_of_operation({bs_init_bits,_}) -> construct; type_of_operation({bs_init_bits,_,_}) -> construct; type_of_operation({bs_put_binary,_,_}) -> construct; -type_of_operation({bs_put_binary_all,_}) -> construct; +type_of_operation({bs_put_binary_all,_,_}) -> construct; type_of_operation({bs_put_float,_,_,_}) -> construct; type_of_operation({bs_put_integer,_,_,_}) -> construct; type_of_operation({bs_put_string,_,_}) -> construct; @@ -78,3 +89,133 @@ type_of_operation(bs_final) -> construct; type_of_operation({bs_append,_,_,_,_}) -> construct; type_of_operation({bs_private_append,_,_}) -> construct; type_of_operation(bs_init_writable) -> construct. + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% Small utility functions: +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +create_lbls(X) when X > 0 -> + [hipe_rtl:mk_new_label()|create_lbls(X-1)]; +create_lbls(0) -> + []. + +%%------------------------------------------------------------------------------ +%% Utilities used by both hipe_rtl_binary_construct and hipe_rtl_binary_match +%%------------------------------------------------------------------------------ + +get_word_integer(Var, Register, SystemLimitLblName, FalseLblName) -> + [EndLbl] = create_lbls(1), + EndName = hipe_rtl:label_name(EndLbl), + get_word_integer(Var, Register,SystemLimitLblName, FalseLblName, EndName, EndName, + [EndLbl]). + +get_word_integer(Var, Register, SystemLimitLblName, FalseLblName, TrueLblName, + BigLblName, Tail) -> + [FixnumLbl, NotFixnumLbl, BignumLbl, SuccessLbl] = create_lbls(4), + [hipe_tagscheme:test_fixnum(Var, hipe_rtl:label_name(FixnumLbl), + hipe_rtl:label_name(NotFixnumLbl), 0.99), + FixnumLbl, + hipe_tagscheme:fixnum_ge(Var, hipe_rtl:mk_imm(hipe_tagscheme:mk_fixnum(0)), + hipe_rtl:label_name(SuccessLbl), FalseLblName, + 0.99), + SuccessLbl, + hipe_tagscheme:untag_fixnum(Register, Var), + hipe_rtl:mk_goto(TrueLblName), + NotFixnumLbl, + hipe_tagscheme:test_pos_bignum_arity(Var, 1, hipe_rtl:label_name(BignumLbl), + FalseLblName, SystemLimitLblName, 0.99), + BignumLbl, + hipe_tagscheme:unsafe_get_one_word_pos_bignum(Register, Var), + hipe_rtl:mk_goto(BigLblName) | Tail]. + +make_size(UnitImm, BitsVar, FailLblName) -> + make_size(UnitImm, BitsVar, FailLblName, FailLblName). + +make_size(1, BitsVar, OverflowLblName, FalseLblName) -> + DstReg = hipe_rtl:mk_new_reg_gcsafe(), + {get_word_integer(BitsVar, DstReg, OverflowLblName, FalseLblName), DstReg}; +make_size(?BYTE_SIZE, BitsVar, OverflowLblName, FalseLblName) -> + DstReg = hipe_rtl:mk_new_reg_gcsafe(), + [FixnumLbl, BignumLbl] = create_lbls(2), + WordBits = hipe_rtl_arch:word_size() * ?BYTE_SIZE, + FixnumLblName = hipe_rtl:label_name(FixnumLbl), + Tail = [BignumLbl, + hipe_rtl:mk_branch(DstReg, 'ltu', + hipe_rtl:mk_imm(1 bsl (WordBits - ?BYTE_SHIFT)), + FixnumLblName, OverflowLblName, 0.99), + FixnumLbl, + hipe_rtl:mk_alu(DstReg, DstReg, sll, hipe_rtl:mk_imm(?BYTE_SHIFT))], + Code = get_word_integer(BitsVar, DstReg, OverflowLblName, FalseLblName, + FixnumLblName, hipe_rtl:label_name(BignumLbl), Tail), + {Code, DstReg}; +make_size(UnitImm, BitsVar, OverflowLblName, FalseLblName) -> + DstReg = hipe_rtl:mk_new_reg_gcsafe(), + UnitList = number2list(UnitImm), + Code = multiply_code(UnitList, BitsVar, DstReg, OverflowLblName, FalseLblName), + {Code, DstReg}. + +multiply_code(List=[Head|_Tail], Variable, Result, OverflowLblName, + FalseLblName) -> + Test = set_high(Head), + Tmp1 = hipe_rtl:mk_new_reg(), + SuccessLbl = hipe_rtl:mk_new_label(), + Register = hipe_rtl:mk_new_reg(), + Code = [hipe_rtl:mk_move(Result, hipe_rtl:mk_imm(0))| + get_word_integer(Variable, Register, OverflowLblName, FalseLblName)] + ++ + [hipe_rtl:mk_alub(Tmp1, Register, 'and', hipe_rtl:mk_imm(Test), + eq, hipe_rtl:label_name(SuccessLbl), + OverflowLblName, 0.99), + SuccessLbl], + multiply_code(List, Register, Result, OverflowLblName, Tmp1, Code). + +multiply_code([ShiftSize|Rest], Register, Result, OverflowLblName, Tmp1, + OldCode) -> + SuccessLbl = hipe_rtl:mk_new_label(), + Code = + OldCode ++ + [hipe_rtl:mk_alu(Tmp1, Register, sll, hipe_rtl:mk_imm(ShiftSize)), + hipe_rtl:mk_alub(Result, Tmp1, 'add', Result, not_overflow, + hipe_rtl:label_name(SuccessLbl), OverflowLblName, 0.99), + SuccessLbl], + multiply_code(Rest, Register, Result, OverflowLblName, Tmp1, Code); +multiply_code([], _Register, _Result, _OverflowLblName, _Tmp1, Code) -> + Code. + +set_high(X) -> + WordBits = hipe_rtl_arch:word_size() * ?BYTE_SIZE, + set_high(min(X, WordBits), WordBits, 0). + +set_high(0, _, Y) -> + Y; +set_high(X, WordBits, Y) -> + set_high(X-1, WordBits, Y+(1 bsl (WordBits-X))). + + +number2list(X) when is_integer(X), X >= 0 -> + number2list(X, []). + +number2list(1, Acc) -> + lists:reverse([0|Acc]); +number2list(0, Acc) -> + lists:reverse(Acc); +number2list(X, Acc) -> + F = floorlog2(X), + number2list(X-(1 bsl F), [F|Acc]). + +floorlog2(X) -> + %% Double-precision floats do not have enough precision to make floorlog2 + %% exact for integers larger than 2^47. + Approx = round(math:log(X)/math:log(2)-0.5), + floorlog2_refine(X, Approx). + +floorlog2_refine(X, Approx) -> + if (1 bsl Approx) > X -> + floorlog2_refine(X, Approx - 1); + (1 bsl (Approx+1)) > X -> + Approx; + true -> + floorlog2_refine(X, Approx + 1) + end. diff --git a/lib/hipe/rtl/hipe_rtl_binary_construct.erl b/lib/hipe/rtl/hipe_rtl_binary_construct.erl index 29993b9715..367d76b24d 100644 --- a/lib/hipe/rtl/hipe_rtl_binary_construct.erl +++ b/lib/hipe/rtl/hipe_rtl_binary_construct.erl @@ -2,37 +2,38 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% %% ==================================================================== -%% Module : hipe_rtl_inline_bs_ops +%% Module : hipe_rtl_binary_construct %% Purpose : %% Notes : -%% History : * 2001-06-14 Erik Johansson ([email protected]): Created. +%% History : Written mostly by Per Gustafsson %% ==================================================================== %% Exports : %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -module(hipe_rtl_binary_construct). + -export([gen_rtl/7]). --import(hipe_tagscheme, [set_field_from_term/3, - get_field_from_term/3, - set_field_from_pointer/3, - get_field_from_pointer/3]). + +-import(hipe_rtl_binary, [get_word_integer/4]). + %%------------------------------------------------------------------------- -include("../main/hipe.hrl"). @@ -45,7 +46,6 @@ -define(BYTE_SIZE, 8). -define(MAX_BINSIZE, ((1 bsl ((hipe_rtl_arch:word_size()*?BYTE_SIZE)-3)) - 1)). - %% ------------------------------------------------------------------------- %% The code is generated as a list of lists, it will be flattened later. %% @@ -56,12 +56,12 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab {bs_put_string, String, SizeInBytes} -> [NewOffset] = get_real(Dst), [Base, Offset] = Args, - put_string(NewOffset, ConstTab, String, SizeInBytes, Base, Offset, + put_string(NewOffset, ConstTab, String, SizeInBytes, Base, Offset, TrueLblName); - _ -> - Code = + _ -> + Code = case BsOP of - {bs_init, Size, _Flags} -> + {bs_init, Size, _Flags} -> [] = Args, [Dst0, Base, Offset] = Dst, case is_illegal_const(Size bsl 3) of @@ -70,14 +70,14 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab false -> const_init2(Size, Dst0, Base, Offset, TrueLblName) end; - - {bs_init, _Flags} -> + + {bs_init, _Flags} -> [Size] = Args, [Dst0, Base, Offset] = Dst, - var_init2(Size, Dst0, Base, Offset, TrueLblName, + var_init2(Size, Dst0, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName); - {bs_init_bits, Size, _Flags} -> + {bs_init_bits, Size, _Flags} -> [] = Args, [Dst0, Base, Offset] = Dst, case is_illegal_const(Size) of @@ -86,18 +86,19 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab false -> const_init_bits(Size, Dst0, Base, Offset, TrueLblName) end; - - {bs_init_bits, _Flags} -> + + {bs_init_bits, _Flags} -> [Size] = Args, [Dst0, Base, Offset] = Dst, - var_init_bits(Size, Dst0, Base, Offset, TrueLblName, + var_init_bits(Size, Dst0, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName); - - {bs_put_binary_all, _Flags} -> + + {bs_put_binary_all, Unit, _Flags} -> [Src, Base, Offset] = Args, [NewOffset] = get_real(Dst), - put_binary_all(NewOffset, Src, Base, Offset, TrueLblName, FalseLblName); - + put_binary_all(NewOffset, Src, Base, Offset, Unit, + TrueLblName, FalseLblName); + {bs_put_binary, Size, _Flags} -> case is_illegal_const(Size) of true -> @@ -106,17 +107,19 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab [NewOffset] = get_real(Dst), case Args of [Src, Base, Offset] -> - put_static_binary(NewOffset, Src, Size, Base, Offset, + put_static_binary(NewOffset, Src, Size, Base, Offset, TrueLblName, FalseLblName); [Src, Bits, Base, Offset] -> - {SizeCode, SizeReg} = make_size(Size, Bits, FalseLblName), - InCode = put_dynamic_binary(NewOffset, Src, SizeReg, Base, + {SizeCode, SizeReg} = + hipe_rtl_binary:make_size(Size, Bits, SystemLimitLblName, + FalseLblName), + InCode = put_dynamic_binary(NewOffset, Src, SizeReg, Base, Offset, TrueLblName, FalseLblName), SizeCode ++ InCode end end; - - {bs_put_float, Size, Flags, ConstInfo} -> + + {bs_put_float, Size, Flags, ConstInfo} -> [NewOffset] = get_real(Dst), Aligned = aligned(Flags), LittleEndian = littleendian(Flags), @@ -126,102 +129,108 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab false -> case Args of [Src, Base, Offset] -> - CCode = static_float_c_code(NewOffset, Src, Base, Offset, Size, Flags, + CCode = static_float_c_code(NewOffset, Src, Base, Offset, Size, Flags, TrueLblName, FalseLblName), - put_float(NewOffset, Src, Base, Offset, Size, CCode, Aligned, + put_float(NewOffset, Src, Base, Offset, Size, CCode, Aligned, LittleEndian, ConstInfo, TrueLblName); [Src, Bits, Base, Offset] -> - {SizeCode, SizeReg} = make_size(Size, Bits, FalseLblName), - InCode = float_c_code(NewOffset, Src, Base, Offset, SizeReg, + {SizeCode, SizeReg} = + hipe_rtl_binary:make_size(Size, Bits, SystemLimitLblName, + FalseLblName), + InCode = float_c_code(NewOffset, Src, Base, Offset, SizeReg, Flags, TrueLblName, FalseLblName), SizeCode ++ InCode end end; - {bs_put_integer, Size, Flags, ConstInfo} -> - Aligned = aligned(Flags), + {bs_put_integer, Size, Flags, ConstInfo} -> + Aligned = aligned(Flags), LittleEndian = littleendian(Flags), [NewOffset] = get_real(Dst), case is_illegal_const(Size) of true -> [hipe_rtl:mk_goto(FalseLblName)]; false -> - case ConstInfo of + case ConstInfo of fail -> [hipe_rtl:mk_goto(FalseLblName)]; - _ -> - case Args of - [Src, Base, Offset] -> + _ -> + case Args of + [Src, Base, Offset] -> CCode = static_int_c_code(NewOffset, Src, - Base, Offset, Size, - Flags, TrueLblName, + Base, Offset, Size, + Flags, TrueLblName, FalseLblName), - put_static_int(NewOffset, Src, Base, Offset, Size, - CCode, Aligned, LittleEndian, TrueLblName); - [Src, Bits, Base, Offset] -> - {SizeCode, SizeReg} = make_size(Size, Bits, + put_static_int(NewOffset, Src, Base, Offset, Size, + CCode, Aligned, LittleEndian, TrueLblName); + [Src, Bits, Base, Offset] -> + {SizeCode, SizeReg} = + hipe_rtl_binary:make_size(Size, Bits, + SystemLimitLblName, FalseLblName), CCode = int_c_code(NewOffset, Src, Base, - Offset, SizeReg, Flags, - TrueLblName, FalseLblName), + Offset, SizeReg, Flags, + TrueLblName, FalseLblName), InCode = - put_dynamic_int(NewOffset, Src, Base, Offset, + put_dynamic_int(NewOffset, Src, Base, Offset, SizeReg, CCode, Aligned, - LittleEndian, TrueLblName), - SizeCode ++ InCode - end - end + LittleEndian, TrueLblName), + SizeCode ++ InCode + end + end end; - - {unsafe_bs_put_integer, 0, _Flags, _ConstInfo} -> - [NewOffset] = get_real(Dst), + + {unsafe_bs_put_integer, 0, _Flags, _ConstInfo} -> + [NewOffset] = get_real(Dst), case Args of [_Src, _Base, Offset] -> [hipe_rtl:mk_move(NewOffset,Offset), - hipe_rtl:mk_goto(TrueLblName)]; - [_Src, _Bits, _Base, Offset] -> + hipe_rtl:mk_goto(TrueLblName)]; + [_Src, _Bits, _Base, Offset] -> [hipe_rtl:mk_move(NewOffset,Offset), - hipe_rtl:mk_goto(TrueLblName)] - end; - - {unsafe_bs_put_integer, Size, Flags, ConstInfo} -> + hipe_rtl:mk_goto(TrueLblName)] + end; + + {unsafe_bs_put_integer, Size, Flags, ConstInfo} -> case is_illegal_const(Size) of true -> [hipe_rtl:mk_goto(FalseLblName)]; false -> Aligned = aligned(Flags), - LittleEndian = littleendian(Flags), - [NewOffset] = get_real(Dst), - case ConstInfo of + LittleEndian = littleendian(Flags), + [NewOffset] = get_real(Dst), + case ConstInfo of fail -> - [hipe_rtl:mk_goto(FalseLblName)]; - _ -> - case Args of - [Src, Base, Offset] -> + [hipe_rtl:mk_goto(FalseLblName)]; + _ -> + case Args of + [Src, Base, Offset] -> CCode = static_int_c_code(NewOffset, Src, - Base, Offset, Size, - Flags, TrueLblName, + Base, Offset, Size, + Flags, TrueLblName, FalseLblName), - put_unsafe_static_int(NewOffset, Src, Base, + put_unsafe_static_int(NewOffset, Src, Base, Offset, Size, - CCode, Aligned, LittleEndian, - TrueLblName); - [Src, Bits, Base, Offset] -> - {SizeCode, SizeReg} = make_size(Size, Bits, - FalseLblName), + CCode, Aligned, LittleEndian, + TrueLblName); + [Src, Bits, Base, Offset] -> + {SizeCode, SizeReg} = + hipe_rtl_binary:make_size(Size, Bits, + SystemLimitLblName, + FalseLblName), CCode = int_c_code(NewOffset, Src, Base, - Offset, SizeReg, Flags, - TrueLblName, FalseLblName), + Offset, SizeReg, Flags, + TrueLblName, FalseLblName), InCode = - put_unsafe_dynamic_int(NewOffset, Src, Base, - Offset, SizeReg, CCode, - Aligned, LittleEndian, + put_unsafe_dynamic_int(NewOffset, Src, Base, + Offset, SizeReg, CCode, + Aligned, LittleEndian, TrueLblName), - SizeCode ++ InCode - end + SizeCode ++ InCode + end end - end; - + end; + bs_utf8_size -> case Dst of [_DstVar] -> @@ -264,13 +273,13 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab [hipe_rtl:mk_call([], bs_validate_unicode, Args, TrueLblName, FalseLblName, not_remote)]; - bs_final -> + bs_final -> Zero = hipe_rtl:mk_imm(0), - [Src, Offset] = Args, + [Src, Offset] = Args, [BitSize, ByteSize] = create_regs(2), [ShortLbl, LongLbl] = create_lbls(2), - case Dst of - [DstVar] -> + case Dst of + [DstVar] -> [hipe_rtl:mk_alub(BitSize, Offset, 'and', ?LOW_BITS, eq, hipe_rtl:label_name(ShortLbl), hipe_rtl:label_name(LongLbl)), ShortLbl, @@ -280,11 +289,11 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab hipe_rtl:mk_alu(ByteSize, Offset, 'srl', ?BYTE_SHIFT), hipe_tagscheme:mk_sub_binary(DstVar, ByteSize, Zero, BitSize, Zero, Src), - hipe_rtl:mk_goto(TrueLblName)]; + hipe_rtl:mk_goto(TrueLblName)]; [] -> - [hipe_rtl:mk_goto(TrueLblName)] - end; - + [hipe_rtl:mk_goto(TrueLblName)] + end; + bs_init_writable -> Zero = hipe_rtl:mk_imm(0), [Size] = Args, @@ -292,63 +301,66 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab [SizeReg] = create_regs(1), [Base] = create_unsafe_regs(1), [hipe_rtl:mk_gctest(?PROC_BIN_WORDSIZE + ?SUB_BIN_WORDSIZE), - check_and_untag_fixnum(Size, SizeReg, FalseLblName), + get_word_integer(Size, SizeReg, SystemLimitLblName, FalseLblName), allocate_writable(DstVar, Base, SizeReg, Zero, Zero), - hipe_rtl:mk_goto(TrueLblName)]; - + hipe_rtl:mk_goto(TrueLblName)]; + {bs_private_append, _U, _F} -> - [Size, Bin] = Args, + [Size, Bin] = Args, [DstVar, Base, Offset] = Dst, [ProcBin] = create_vars(1), [SubSize, SizeReg, EndSubSize, EndSubBitSize] = create_regs(4), SubBinSize = {sub_binary, binsize}, - [get_field_from_term({sub_binary, orig}, Bin, ProcBin), - get_field_from_term(SubBinSize, Bin, SubSize), - check_and_untag_fixnum(Size, SizeReg, FalseLblName), + [hipe_tagscheme:get_field_from_term({sub_binary, orig}, Bin, ProcBin), + hipe_tagscheme:get_field_from_term(SubBinSize, Bin, SubSize), + get_word_integer(Size, SizeReg, SystemLimitLblName, FalseLblName), realloc_binary(SizeReg, ProcBin, Base), calculate_sizes(Bin, SizeReg, Offset, EndSubSize, EndSubBitSize), - set_field_from_term(SubBinSize, Bin, EndSubSize), - set_field_from_term({sub_binary, bitsize}, Bin, EndSubBitSize), + hipe_tagscheme:set_field_from_term(SubBinSize, Bin, EndSubSize), + hipe_tagscheme:set_field_from_term({sub_binary, bitsize}, Bin, EndSubBitSize), hipe_rtl:mk_move(DstVar, Bin), hipe_rtl:mk_goto(TrueLblName)]; - {bs_append, _U, _F, _B, _Bla} -> - [Size, Bin] = Args, - [DstVar, Base, Offset] = Dst, + {bs_append, _U, _F, Unit, _Bla} -> + [Size, Bin] = Args, + [DstVar, Base, Offset] = Dst, [ProcBin] = create_vars(1), - [Flags, SizeReg, IsWritable, EndSubSize, EndSubBitSize] = + [Flags, SizeReg, IsWritable, EndSubSize, EndSubBitSize] = create_regs(5), - [ContLbl,ContLbl2,ContLbl3,WritableLbl,NotWritableLbl] = Lbls = - create_lbls(5), - [ContLblName, ContLbl2Name, ContLbl3Name, Writable, NotWritable] = + [ContLbl,ContLbl2,ContLbl3,ContLbl4,WritableLbl,NotWritableLbl] = + Lbls = create_lbls(6), + [ContLblName, ContLbl2Name, ContLbl3Name, ContLbl4Name, + Writable, NotWritable] = [hipe_rtl:label_name(Lbl) || Lbl <- Lbls], Zero = hipe_rtl:mk_imm(0), SubIsWritable = {sub_binary, is_writable}, [hipe_rtl:mk_gctest(?SUB_BIN_WORDSIZE + ?PROC_BIN_WORDSIZE), - check_and_untag_fixnum(Size, SizeReg, FalseLblName), - hipe_tagscheme:test_bitstr(Bin, ContLblName, FalseLblName, 0.99), - ContLbl, - hipe_tagscheme:test_subbinary(Bin,ContLbl2Name, NotWritable), + get_word_integer(Size, SizeReg, SystemLimitLblName, FalseLblName), + hipe_tagscheme:test_bitstr(Bin, ContLblName, FalseLblName, 0.99), + ContLbl, + hipe_tagscheme:test_subbinary(Bin,ContLbl2Name, NotWritable), ContLbl2, - get_field_from_term(SubIsWritable, Bin, IsWritable), + hipe_tagscheme:get_field_from_term(SubIsWritable, Bin, IsWritable), hipe_rtl:mk_branch(IsWritable, 'ne', Zero, ContLbl3Name, NotWritable), ContLbl3, - get_field_from_term({sub_binary, orig}, Bin, ProcBin), - get_field_from_term({proc_bin, flags}, ProcBin, Flags), + hipe_tagscheme:get_field_from_term({sub_binary, orig}, Bin, ProcBin), + hipe_tagscheme:get_field_from_term({proc_bin, flags}, ProcBin, Flags), hipe_rtl:mk_alub(Flags, Flags, 'and', - hipe_rtl:mk_imm(?PB_IS_WRITABLE), - eq, NotWritable, Writable, 0.01), + hipe_rtl:mk_imm(?PB_IS_WRITABLE), + eq, NotWritable, ContLbl4Name, 0.01), + ContLbl4, + calculate_sizes(Bin, SizeReg, Offset, EndSubSize, EndSubBitSize), + is_divisible(Offset, Unit, Writable, FalseLblName), WritableLbl, - set_field_from_term(SubIsWritable, Bin, Zero), + hipe_tagscheme:set_field_from_term(SubIsWritable, Bin, Zero), realloc_binary(SizeReg, ProcBin, Base), - calculate_sizes(Bin, SizeReg, Offset, EndSubSize, EndSubBitSize), hipe_tagscheme:mk_sub_binary(DstVar, EndSubSize, Zero, EndSubBitSize, Zero, hipe_rtl:mk_imm(1), ProcBin), hipe_rtl:mk_goto(TrueLblName), NotWritableLbl, - not_writable_code(Bin, SizeReg, DstVar, Base, Offset, + not_writable_code(Bin, SizeReg, DstVar, Base, Offset, Unit, TrueLblName, FalseLblName)] end, {Code, ConstTab} @@ -360,7 +372,7 @@ gen_rtl(BsOP, Dst, Args, TrueLblName, FalseLblName, SystemLimitLblName, ConstTab %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -not_writable_code(Bin, SizeReg, Dst, Base, Offset, +not_writable_code(Bin, SizeReg, Dst, Base, Offset, Unit, TrueLblName, FalseLblName) -> [SrcBase] = create_unsafe_regs(1), [SrcOffset, SrcSize, TotSize, TotBytes, UsedBytes] = create_regs(5), @@ -371,15 +383,15 @@ not_writable_code(Bin, SizeReg, Dst, Base, Offset, hipe_rtl:mk_alu(TotBytes, TotSize, add, ?LOW_BITS), hipe_rtl:mk_alu(TotBytes, TotBytes, srl, ?BYTE_SHIFT), hipe_rtl:mk_alu(UsedBytes, TotBytes, sll, hipe_rtl:mk_imm(1)), - hipe_rtl:mk_branch(UsedBytes, ge, hipe_rtl:mk_imm(256), + hipe_rtl:mk_branch(UsedBytes, geu, hipe_rtl:mk_imm(256), AllLblName, IncLblName), IncLbl, hipe_rtl:mk_move(UsedBytes, hipe_rtl:mk_imm(256)), AllLbl, allocate_writable(Dst, Base, UsedBytes, TotBytes, TotSize), - put_binary_all(Offset, Bin, Base, hipe_rtl:mk_imm(0), + put_binary_all(Offset, Bin, Base, hipe_rtl:mk_imm(0), Unit, TrueLblName, FalseLblName)]. - + allocate_writable(Dst, Base, UsedBytes, TotBytes, TotSize) -> Zero = hipe_rtl:mk_imm(0), [NextLbl] = create_lbls(1), @@ -396,17 +408,7 @@ allocate_writable(Dst, Base, UsedBytes, TotBytes, TotSize) -> hipe_tagscheme:mk_sub_binary(Dst, EndSubSize, Zero, EndSubBitSize, Zero, hipe_rtl:mk_imm(1), ProcBin)]. -check_and_untag_fixnum(Size, SizeReg, FalseLblName) -> - [ContLbl,NextLbl] = Lbls = create_lbls(2), - [ContLblName,NextLblName] = get_label_names(Lbls), - [hipe_tagscheme:test_fixnum(Size, ContLblName, FalseLblName, 0.99), - ContLbl, - hipe_tagscheme:untag_fixnum(SizeReg,Size), - hipe_rtl:mk_branch(SizeReg, ge, hipe_rtl:mk_imm(0), NextLblName, - FalseLblName), - NextLbl]. - -realloc_binary(SizeReg, ProcBin, Base) -> +realloc_binary(SizeReg, ProcBin, Base) -> [NoReallocLbl, ReallocLbl, NextLbl, ContLbl] = Lbls = create_lbls(4), [NoReallocLblName, ReallocLblName, NextLblName, ContLblName] = [hipe_rtl:label_name(Lbl) || Lbl <- Lbls], @@ -417,36 +419,36 @@ realloc_binary(SizeReg, ProcBin, Base) -> ProcBinValTag = {proc_bin, val}, ProcBinBytesTag = {proc_bin, bytes}, BinOrigSizeTag = {binary, orig_size}, - [get_field_from_term(ProcBinSizeTag, ProcBin, PBSize), + [hipe_tagscheme:get_field_from_term(ProcBinSizeTag, ProcBin, PBSize), hipe_rtl:mk_alu(Tmp, SizeReg, 'add', ?LOW_BITS), hipe_rtl:mk_alu(ByteSize, Tmp, 'srl', ?BYTE_SHIFT), hipe_rtl:mk_alu(ResultingSize, ByteSize, 'add', PBSize), - set_field_from_term(ProcBinSizeTag, ProcBin, ResultingSize), - get_field_from_term(ProcBinFlagsTag, ProcBin, Flags), + hipe_tagscheme:set_field_from_term(ProcBinSizeTag, ProcBin, ResultingSize), + hipe_tagscheme:get_field_from_term(ProcBinFlagsTag, ProcBin, Flags), hipe_rtl:mk_alu(Flags, Flags, 'or', hipe_rtl:mk_imm(?PB_ACTIVE_WRITER)), - set_field_from_term(ProcBinFlagsTag, ProcBin, Flags), - get_field_from_term(ProcBinValTag, ProcBin, BinPointer), - get_field_from_pointer(BinOrigSizeTag, BinPointer, OrigSize), - hipe_rtl:mk_branch(OrigSize, 'lt', ResultingSize, + hipe_tagscheme:set_field_from_term(ProcBinFlagsTag, ProcBin, Flags), + hipe_tagscheme:get_field_from_term(ProcBinValTag, ProcBin, BinPointer), + hipe_tagscheme:get_field_from_pointer(BinOrigSizeTag, BinPointer, OrigSize), + hipe_rtl:mk_branch(OrigSize, 'ltu', ResultingSize, ReallocLblName, NoReallocLblName), NoReallocLbl, - get_field_from_term(ProcBinBytesTag, ProcBin, Base), + hipe_tagscheme:get_field_from_term(ProcBinBytesTag, ProcBin, Base), hipe_rtl:mk_goto(ContLblName), ReallocLbl, hipe_rtl:mk_alu(NewSize, ResultingSize, 'sll', hipe_rtl:mk_imm(1)), - hipe_rtl:mk_call([BinPointer], bs_reallocate, [BinPointer, NewSize], + hipe_rtl:mk_call([BinPointer], bs_reallocate, [BinPointer, NewSize], NextLblName, [], not_remote), NextLbl, - set_field_from_pointer(BinOrigSizeTag, BinPointer, NewSize), - set_field_from_term(ProcBinValTag, ProcBin, BinPointer), + hipe_tagscheme:set_field_from_pointer(BinOrigSizeTag, BinPointer, NewSize), + hipe_tagscheme:set_field_from_term(ProcBinValTag, ProcBin, BinPointer), hipe_tagscheme:extract_binary_bytes(BinPointer, Base), - set_field_from_term(ProcBinBytesTag, ProcBin, Base), + hipe_tagscheme:set_field_from_term(ProcBinBytesTag, ProcBin, Base), ContLbl]. calculate_sizes(Bin, SizeReg, Offset, EndSubSize, EndSubBitSize) -> [SubSize, SubBitSize, EndSize] = create_regs(3), - [get_field_from_term({sub_binary, binsize}, Bin, SubSize), - get_field_from_term({sub_binary, bitsize}, Bin, SubBitSize), + [hipe_tagscheme:get_field_from_term({sub_binary, binsize}, Bin, SubSize), + hipe_tagscheme:get_field_from_term({sub_binary, bitsize}, Bin, SubBitSize), hipe_rtl:mk_alu(Offset, SubSize, 'sll', ?BYTE_SHIFT), hipe_rtl:mk_alu(Offset, Offset, 'add', SubBitSize), hipe_rtl:mk_alu(EndSize, Offset, 'add', SizeReg), @@ -487,7 +489,7 @@ static_int_c_code(NewOffset, Src, Base, Offset, Size, Flags, int_c_code(NewOffset, Src, Base, Offset, SizeReg, Flags, TrueLblName, FalseLblName) -> - put_c_code(bs_put_big_integer, NewOffset, Src, Base, Offset, SizeReg, + put_c_code(bs_put_big_integer, NewOffset, Src, Base, Offset, SizeReg, Flags, TrueLblName, FalseLblName). binary_c_code(NewOffset, Src, Base, Offset, Size, TrueLblName) -> @@ -495,8 +497,8 @@ binary_c_code(NewOffset, Src, Base, Offset, Size, TrueLblName) -> [SizeReg, FlagsReg] = create_regs(2), [hipe_rtl:mk_move(FlagsReg, hipe_rtl:mk_imm(0)), hipe_rtl:mk_move(SizeReg, Size), - hipe_rtl:mk_call([], bs_put_bits, [Src, SizeReg, Base, Offset, FlagsReg], - hipe_rtl:label_name(PassedLbl),[],not_remote), + hipe_rtl:mk_call([], bs_put_bits, [Src, SizeReg, Base, Offset, FlagsReg], + hipe_rtl:label_name(PassedLbl), [], not_remote), PassedLbl, hipe_rtl:mk_alu(NewOffset, Offset, add, SizeReg), hipe_rtl:mk_goto(TrueLblName)]. @@ -506,7 +508,7 @@ put_c_code(Func, NewOffset, Src, Base, Offset, SizeReg, Flags, PassedLbl = hipe_rtl:mk_new_label(), [FlagsReg] = create_regs(1), [hipe_rtl:mk_move(FlagsReg, hipe_rtl:mk_imm(Flags)), - gen_test_sideffect_bs_call(Func, [Src, SizeReg, Base, Offset, FlagsReg], + gen_test_sideffect_bs_call(Func, [Src, SizeReg, Base, Offset, FlagsReg], hipe_rtl:label_name(PassedLbl), FalseLblName), PassedLbl, hipe_rtl:mk_alu(NewOffset, Offset, add, SizeReg), @@ -518,7 +520,7 @@ gen_test_sideffect_bs_call(Name, Args, TrueLblName, FalseLblName) -> [hipe_rtl:mk_call([Tmp1], Name, Args, hipe_rtl:label_name(RetLbl), [], not_remote), RetLbl, - hipe_rtl:mk_branch(Tmp1, eq, hipe_rtl:mk_imm(0), + hipe_rtl:mk_branch(Tmp1, eq, hipe_rtl:mk_imm(0), FalseLblName, TrueLblName, 0.01)]. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -539,7 +541,7 @@ create_unsafe_regs(0) -> create_vars(X) when X > 0 -> [hipe_rtl:mk_new_var()|create_vars(X-1)]; -create_vars(0) -> +create_vars(0) -> []. create_lbls(X) when X > 0 -> @@ -577,7 +579,7 @@ get_real(Dst) -> %% The following functions are called from the translation switch: %% %% - put_string/7 creates code to copy a string to a binary -%% starting at base+offset and ending at base+newoffset +%% starting at base+offset and ending at base+newoffset %% %% - const_init2/6 initializes the creation of a binary of constant size %% @@ -604,10 +606,9 @@ put_string(NewOffset, ConstTab, String, SizeInBytes, Base, Offset, TLName) -> [StringBase] = create_regs(1), {NewTab, Lbl} = hipe_consttab:insert_block(ConstTab, byte, String), {[hipe_rtl:mk_load_address(StringBase, Lbl, constant)| - copy_string(StringBase, SizeInBytes, Base, Offset, - NewOffset, TLName)], + copy_string(StringBase, SizeInBytes, Base, Offset, NewOffset, TLName)], NewTab}. - + const_init2(Size, Dst, Base, Offset, TrueLblName) -> Log2WordSize = hipe_rtl_arch:log2_word_size(), WordSize = hipe_rtl_arch:word_size(), @@ -637,27 +638,29 @@ const_init_bits(Size, Dst, Base, Offset, TrueLblName) -> TmpDst = hipe_rtl:mk_new_var(), Zero = hipe_rtl:mk_imm(0), {ExtraSpace, SubBinCode} = - if (Size rem ?BYTE_SIZE) =:= 0 -> - {0,[hipe_rtl:mk_move(Dst, TmpDst)]}; - true -> + case (Size rem ?BYTE_SIZE) =:= 0 of + true -> + {0, [hipe_rtl:mk_move(Dst, TmpDst)]}; + false -> {?SUB_BIN_WORDSIZE, - hipe_tagscheme:mk_sub_binary(Dst, hipe_rtl:mk_imm(Size bsr 3), Zero, + hipe_tagscheme:mk_sub_binary(Dst, hipe_rtl:mk_imm(Size bsr 3), Zero, hipe_rtl:mk_imm(Size band ?LOW_BITS_INT), Zero, TmpDst)} end, BaseBinCode = - if Size =< (?MAX_HEAP_BIN_SIZE * 8) -> - ByteSize = (Size + 7) div 8, - [hipe_rtl:mk_gctest(((ByteSize+ 3*WordSize-1) bsr Log2WordSize)+ ExtraSpace), + case Size =< (?MAX_HEAP_BIN_SIZE * 8) of + true -> + ByteSize = (Size + 7) div 8, + [hipe_rtl:mk_gctest(((ByteSize + 3*WordSize-1) bsr Log2WordSize) + ExtraSpace), hipe_tagscheme:create_heap_binary(Base, ByteSize, TmpDst), hipe_rtl:mk_move(Offset, Zero)]; - true -> + false -> ByteSize = hipe_rtl:mk_new_reg(), [hipe_rtl:mk_gctest(?PROC_BIN_WORDSIZE+ExtraSpace), hipe_rtl:mk_move(Offset, Zero), hipe_rtl:mk_move(ByteSize, hipe_rtl:mk_imm((Size+7) bsr 3)), hipe_rtl:mk_call([Base], bs_allocate, [ByteSize], - hipe_rtl:label_name(NextLbl),[],not_remote), + hipe_rtl:label_name(NextLbl), [], not_remote), NextLbl, hipe_tagscheme:create_refc_binary(Base, ByteSize, TmpDst)] end, @@ -666,16 +669,16 @@ const_init_bits(Size, Dst, Base, Offset, TrueLblName) -> var_init2(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName) -> Log2WordSize = hipe_rtl_arch:log2_word_size(), WordSize = hipe_rtl_arch:word_size(), - [ContLbl,HeapLbl,REFCLbl,NextLbl] = create_lbls(4), - [USize,Tmp] = create_unsafe_regs(2), - [get_32_bit_value(Size, USize, SystemLimitLblName, FalseLblName), - hipe_rtl:mk_branch(USize, le, hipe_rtl:mk_imm(?MAX_BINSIZE), - hipe_rtl:label_name(ContLbl), + [ContLbl, HeapLbl, REFCLbl, NextLbl] = create_lbls(4), + [USize, Tmp] = create_unsafe_regs(2), + [get_word_integer(Size, USize, SystemLimitLblName, FalseLblName), + hipe_rtl:mk_branch(USize, leu, hipe_rtl:mk_imm(?MAX_BINSIZE), + hipe_rtl:label_name(ContLbl), SystemLimitLblName), ContLbl, hipe_rtl:mk_move(Offset, hipe_rtl:mk_imm(0)), - hipe_rtl:mk_branch(USize, le, hipe_rtl:mk_imm(?MAX_HEAP_BIN_SIZE), - hipe_rtl:label_name(HeapLbl), + hipe_rtl:mk_branch(USize, leu, hipe_rtl:mk_imm(?MAX_HEAP_BIN_SIZE), + hipe_rtl:label_name(HeapLbl), hipe_rtl:label_name(REFCLbl)), HeapLbl, hipe_rtl:mk_alu(Tmp, USize, add, hipe_rtl:mk_imm(3*WordSize-1)), @@ -693,20 +696,20 @@ var_init2(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName hipe_rtl:mk_goto(TrueLblName)]. var_init_bits(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLblName) -> - [HeapLbl,REFCLbl,NextLbl,NoSubLbl,SubLbl,ContLbl, - NoCreateSubBin, CreateSubBin, JoinLbl, JoinLbl2] = create_lbls(10), - [USize,ByteSize,TotByteSize,OffsetBits] = create_regs(4), + [HeapLbl, REFCLbl, NextLbl, NoSubLbl, SubLbl, + NoCreateSubBin, CreateSubBin, JoinLbl, JoinLbl2] = create_lbls(9), + [USize, ByteSize, TotByteSize, OffsetBits] = create_regs(4), [TmpDst] = create_unsafe_regs(1), Log2WordSize = hipe_rtl_arch:log2_word_size(), WordSize = hipe_rtl_arch:word_size(), - MaximumWords = + MaximumWords = erlang:max((?MAX_HEAP_BIN_SIZE + 3*WordSize) bsr Log2WordSize, ?PROC_BIN_WORDSIZE) + ?SUB_BIN_WORDSIZE, Zero = hipe_rtl:mk_imm(0), [hipe_rtl:mk_gctest(MaximumWords), - get_32_bit_value(Size, USize, SystemLimitLblName, FalseLblName), + get_word_integer(Size, USize, SystemLimitLblName, FalseLblName), hipe_rtl:mk_alu(ByteSize, USize, srl, ?BYTE_SHIFT), - hipe_rtl:mk_alub(OffsetBits, USize, 'and', ?LOW_BITS, eq, + hipe_rtl:mk_alub(OffsetBits, USize, 'and', ?LOW_BITS, eq, hipe_rtl:label_name(NoSubLbl), hipe_rtl:label_name(SubLbl)), NoSubLbl, @@ -715,25 +718,21 @@ var_init_bits(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLbl SubLbl, hipe_rtl:mk_alu(TotByteSize, ByteSize, 'add', hipe_rtl:mk_imm(1)), JoinLbl, - hipe_rtl:mk_branch(USize, le, hipe_rtl:mk_imm(?MAX_BINSIZE), - hipe_rtl:label_name(ContLbl), - SystemLimitLblName), - ContLbl, - hipe_rtl:mk_branch(TotByteSize, 'le', hipe_rtl:mk_imm(?MAX_HEAP_BIN_SIZE), - hipe_rtl:label_name(HeapLbl), + hipe_rtl:mk_branch(TotByteSize, 'leu', hipe_rtl:mk_imm(?MAX_HEAP_BIN_SIZE), + hipe_rtl:label_name(HeapLbl), hipe_rtl:label_name(REFCLbl)), HeapLbl, hipe_tagscheme:create_heap_binary(Base, TotByteSize, TmpDst), hipe_rtl:mk_goto(hipe_rtl:label_name(JoinLbl2)), REFCLbl, hipe_rtl:mk_call([Base], bs_allocate, [TotByteSize], - hipe_rtl:label_name(NextLbl),[],not_remote), + hipe_rtl:label_name(NextLbl), [], not_remote), NextLbl, hipe_tagscheme:create_refc_binary(Base, TotByteSize, TmpDst), JoinLbl2, hipe_rtl:mk_move(Offset, Zero), hipe_rtl:mk_branch(OffsetBits, 'eq', Zero, - hipe_rtl:label_name(NoCreateSubBin), + hipe_rtl:label_name(NoCreateSubBin), hipe_rtl:label_name(CreateSubBin)), CreateSubBin, hipe_tagscheme:mk_sub_binary(Dst, ByteSize, Zero, OffsetBits, Zero, TmpDst), @@ -742,20 +741,23 @@ var_init_bits(Size, Dst, Base, Offset, TrueLblName, SystemLimitLblName, FalseLbl hipe_rtl:mk_move(Dst, TmpDst), hipe_rtl:mk_goto(TrueLblName)]. -put_binary_all(NewOffset, Src, Base, Offset, TLName, FLName) -> - [SrcBase,SrcOffset,NumBits] = create_regs(3), +put_binary_all(NewOffset, Src, Base, Offset, Unit, TLName, FLName) -> + [SrcBase, SrcOffset, NumBits] = create_regs(3), + [ContLbl] = create_lbls(1), CCode = binary_c_code(NewOffset, Src, Base, Offset, NumBits, TLName), - AlignedCode = copy_aligned_bytes(SrcBase, SrcOffset, NumBits, Base, Offset, + AlignedCode = copy_aligned_bytes(SrcBase, SrcOffset, NumBits, Base, Offset, NewOffset, TLName), - get_base_offset_size(Src, SrcBase, SrcOffset, NumBits,FLName) ++ - test_alignment(SrcOffset, NumBits, Offset, AlignedCode, CCode). + [get_base_offset_size(Src, SrcBase, SrcOffset, NumBits,FLName), + is_divisible(NumBits, Unit, hipe_rtl:label_name(ContLbl), FLName), + ContLbl + |test_alignment(SrcOffset, NumBits, Offset, AlignedCode, CCode)]. test_alignment(SrcOffset, NumBits, Offset, AlignedCode, CCode) -> - [Tmp] = create_regs(1), - [AlignedLbl,CLbl] = create_lbls(2), + [Tmp] = create_regs(1), + [AlignedLbl, CLbl] = create_lbls(2), [hipe_rtl:mk_alu(Tmp, SrcOffset, 'or', NumBits), hipe_rtl:mk_alu(Tmp, Tmp, 'or', Offset), - hipe_rtl:mk_alub(Tmp, Tmp, 'and', ?LOW_BITS, 'eq', + hipe_rtl:mk_alub(Tmp, Tmp, 'and', ?LOW_BITS, 'eq', hipe_rtl:label_name(AlignedLbl), hipe_rtl:label_name(CLbl)), AlignedLbl, @@ -764,12 +766,12 @@ test_alignment(SrcOffset, NumBits, Offset, AlignedCode, CCode) -> CCode]. put_static_binary(NewOffset, Src, Size, Base, Offset, TLName, FLName) -> - [SrcBase] = create_unsafe_regs(1), + [SrcBase] = create_unsafe_regs(1), [SrcOffset, SrcSize] = create_regs(2), case Size of 0 -> get_base_offset_size(Src, SrcBase, SrcOffset, SrcSize, FLName) ++ - [hipe_rtl:mk_move(NewOffset, Offset), + [hipe_rtl:mk_move(NewOffset, Offset), hipe_rtl:mk_goto(TLName)]; _ -> SizeImm = hipe_rtl:mk_imm(Size), @@ -785,13 +787,13 @@ put_dynamic_binary(NewOffset, Src, SizeReg, Base, Offset, TLName, FLName) -> [SrcBase] = create_unsafe_regs(1), [SrcOffset, SrcSize] = create_regs(2), CCode = binary_c_code(NewOffset, Src, Base, Offset, SizeReg, TLName), - AlignedCode = copy_aligned_bytes(SrcBase, SrcOffset, SizeReg, Base, Offset, + AlignedCode = copy_aligned_bytes(SrcBase, SrcOffset, SizeReg, Base, Offset, NewOffset, TLName), get_base_offset_size(Src, SrcBase, SrcOffset, SrcSize, FLName) ++ small_check(SizeReg, SrcSize, FLName) ++ test_alignment(SrcOffset, SizeReg, Offset, AlignedCode, CCode). -put_float(NewOffset, Src, Base, Offset, 64, CCode, Aligned, LittleEndian, +put_float(NewOffset, Src, Base, Offset, 64, CCode, Aligned, LittleEndian, ConstInfo, TrueLblName) -> [CLbl] = create_lbls(1), case {Aligned, LittleEndian} of @@ -825,12 +827,12 @@ put_static_int(NewOffset, Src, Base, Offset, Size, CCode, Aligned, {false, true} -> CCode; {false, false} -> - Init ++ + Init ++ copy_offset_int_big(Base, Offset, NewOffset, Size, UntaggedSrc) ++ End end. -put_unsafe_static_int(NewOffset, Src, Base, Offset, Size, CCode, Aligned, +put_unsafe_static_int(NewOffset, Src, Base, Offset, Size, CCode, Aligned, LittleEndian, TrueLblName) -> {Init, End, UntaggedSrc} = make_init_end(Src, TrueLblName), case {Aligned, LittleEndian} of @@ -845,7 +847,7 @@ put_unsafe_static_int(NewOffset, Src, Base, Offset, Size, CCode, Aligned, {false, true} -> CCode; {false, false} -> - Init ++ + Init ++ copy_offset_int_big(Base, Offset, NewOffset, Size, UntaggedSrc) ++ End end. @@ -857,7 +859,7 @@ put_dynamic_int(NewOffset, Src, Base, Offset, SizeReg, CCode, Aligned, true -> case LittleEndian of true -> - Init ++ + Init ++ copy_int_little(Base, Offset, NewOffset, SizeReg, UntaggedSrc) ++ End; false -> @@ -876,7 +878,7 @@ put_unsafe_dynamic_int(NewOffset, Src, Base, Offset, SizeReg, CCode, Aligned, true -> case LittleEndian of true -> - Init ++ + Init ++ copy_int_little(Base, Offset, NewOffset, SizeReg, UntaggedSrc) ++ End; false -> @@ -887,7 +889,7 @@ put_unsafe_dynamic_int(NewOffset, Src, Base, Offset, SizeReg, CCode, Aligned, false -> CCode end. - + %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %% @@ -898,7 +900,7 @@ put_unsafe_dynamic_int(NewOffset, Src, Base, Offset, SizeReg, CCode, Aligned, make_init_end(Src, CCode, TrueLblName) -> [CLbl, SuccessLbl] = create_lbls(2), [UntaggedSrc] = create_regs(1), - Init = [hipe_tagscheme:test_fixnum(Src, hipe_rtl:label_name(SuccessLbl), + Init = [hipe_tagscheme:test_fixnum(Src, hipe_rtl:label_name(SuccessLbl), hipe_rtl:label_name(CLbl), 0.99), SuccessLbl, hipe_tagscheme:untag_fixnum(UntaggedSrc,Src)], @@ -911,28 +913,28 @@ make_init_end(Src, TrueLblName) -> End = [hipe_rtl:mk_goto(TrueLblName)], {Init, End, UntaggedSrc}. -get_base_offset_size(Binary, SrcBase, SrcOffset, SrcSize, FLName) -> +get_base_offset_size(Binary, SrcBase, SrcOffset, SrcSize, FLName) -> [JoinLbl, EndLbl, SuccessLbl, SubLbl, OtherLbl, HeapLbl, REFCLbl] = Lbls = create_lbls(7), - [JoinLblName, EndLblName, SuccessLblName, SubLblName, + [JoinLblName, EndLblName, SuccessLblName, SubLblName, OtherLblName, HeapLblName, REFCLblName] = get_label_names(Lbls), - [BitSize,BitOffset] = create_regs(2), + [BitSize, BitOffset] = create_regs(2), [Orig] = create_vars(1), [hipe_tagscheme:test_bitstr(Binary, SuccessLblName, FLName, 0.99), SuccessLbl, - get_field_from_term({sub_binary,binsize}, Binary, SrcSize), + hipe_tagscheme:get_field_from_term({sub_binary,binsize}, Binary, SrcSize), hipe_rtl:mk_alu(SrcSize, SrcSize, sll, ?BYTE_SHIFT), hipe_tagscheme:test_subbinary(Binary, SubLblName, OtherLblName), SubLbl, - get_field_from_term({sub_binary,bitsize}, Binary, BitSize), - get_field_from_term({sub_binary,offset}, Binary, SrcOffset), + hipe_tagscheme:get_field_from_term({sub_binary,bitsize}, Binary, BitSize), + hipe_tagscheme:get_field_from_term({sub_binary,offset}, Binary, SrcOffset), hipe_rtl:mk_alu(SrcSize, SrcSize, add, BitSize), - get_field_from_term({sub_binary,bitoffset}, Binary, BitOffset), + hipe_tagscheme:get_field_from_term({sub_binary,bitoffset}, Binary, BitOffset), hipe_rtl:mk_alu(SrcOffset, SrcOffset, sll, ?BYTE_SHIFT), hipe_rtl:mk_alu(SrcOffset, SrcOffset, add, BitOffset), - get_field_from_term({sub_binary,orig}, Binary, Orig), + hipe_tagscheme:get_field_from_term({sub_binary,orig}, Binary, Orig), hipe_rtl:mk_goto(JoinLblName), - OtherLbl, + OtherLbl, hipe_rtl:mk_move(SrcOffset, hipe_rtl:mk_imm(0)), hipe_rtl:mk_move(Orig, Binary), JoinLbl, @@ -941,29 +943,29 @@ get_base_offset_size(Binary, SrcBase, SrcOffset, SrcSize, FLName) -> hipe_rtl:mk_alu(SrcBase, Orig, add, hipe_rtl:mk_imm(?HEAP_BIN_DATA-2)), hipe_rtl:mk_goto(EndLblName), REFCLbl, - get_field_from_term({proc_bin,bytes}, Orig, SrcBase), + hipe_tagscheme:get_field_from_term({proc_bin,bytes}, Orig, SrcBase), EndLbl]. copy_aligned_bytes(CopyBase, CopyOffset, Size, Base, Offset, NewOffset, TrueLblName) -> [BaseDst, BaseSrc] = create_unsafe_regs(2), [Iter, Extra, BothOffset] = create_regs(3), initializations(BaseSrc, BaseDst, BothOffset, CopyOffset, Offset, CopyBase, Base) ++ - [hipe_rtl:mk_alu(Extra, Size, 'and', ?LOW_BITS), - hipe_rtl:mk_alu(Iter, Size, srl, ?BYTE_SHIFT), + [hipe_rtl:mk_alu(Extra, Size, 'and', ?LOW_BITS), + hipe_rtl:mk_alu(Iter, Size, srl, ?BYTE_SHIFT), hipe_rtl:mk_alu(NewOffset, Offset, 'add', Size)] ++ easy_loop(BaseSrc, BaseDst, BothOffset, Iter, Extra, TrueLblName). copy_string(StringBase, StringSize, BinBase, BinOffset, NewOffset, TrueLblName) -> [TmpOffset,BothOffset,InitOffs] = create_regs(3), [NewBinBase] = create_unsafe_regs(1), - [EasyLbl,HardLbl] = create_lbls(2), + [EasyLbl, HardLbl] = create_lbls(2), [hipe_rtl:mk_alu(TmpOffset, BinOffset, srl, ?BYTE_SHIFT), hipe_rtl:mk_alu(NewBinBase, BinBase, add, TmpOffset), hipe_rtl:mk_move(BothOffset, hipe_rtl:mk_imm(0)), hipe_rtl:mk_alub(InitOffs, BinOffset, 'and', ?LOW_BITS, eq, hipe_rtl:label_name(EasyLbl), hipe_rtl:label_name(HardLbl)), EasyLbl, - hipe_rtl:mk_alu(NewOffset, BinOffset, add, + hipe_rtl:mk_alu(NewOffset, BinOffset, add, hipe_rtl:mk_imm(?bytes_to_bits(StringSize)))] ++ easy_loop(StringBase, NewBinBase, BothOffset, hipe_rtl:mk_imm(StringSize), hipe_rtl:mk_imm(0), TrueLblName) ++ @@ -975,13 +977,13 @@ copy_string(StringBase, StringSize, BinBase, BinOffset, NewOffset, TrueLblName) small_check(SizeVar, CopySize, FalseLblName) -> SuccessLbl = hipe_rtl:mk_new_label(), - [hipe_rtl:mk_branch(SizeVar, le, CopySize, + [hipe_rtl:mk_branch(SizeVar, leu, CopySize, hipe_rtl:label_name(SuccessLbl), FalseLblName), SuccessLbl]. -easy_loop(BaseSrc, BaseDst, BothOffset, Iterations, Extra, TrueLblName) -> - [Tmp1,Shift] = create_regs(2), - [LoopLbl,TopLbl,EndLbl,ExtraLbl] = create_lbls(4), +easy_loop(BaseSrc, BaseDst, BothOffset, Iterations, Extra, TrueLblName) -> + [Tmp1, Shift] = create_regs(2), + [LoopLbl, TopLbl, EndLbl, ExtraLbl] = create_lbls(4), [TopLbl, hipe_rtl:mk_branch(BothOffset, ne, Iterations, hipe_rtl:label_name(LoopLbl), hipe_rtl:label_name(EndLbl), 0.99), @@ -1001,17 +1003,17 @@ easy_loop(BaseSrc, BaseDst, BothOffset, Iterations, Extra, TrueLblName) -> hipe_rtl:mk_store(BaseDst, BothOffset, Tmp1, byte), hipe_rtl:mk_goto(TrueLblName)]. -hard_loop(BaseSrc, BaseDst, BothOffset, Iterations, +hard_loop(BaseSrc, BaseDst, BothOffset, Iterations, InitOffset, TrueLblName) -> [Tmp1, Tmp2, OldByte, NewByte, SaveByte] = create_regs(5), - [LoopLbl,EndLbl,TopLbl] = create_lbls(3), + [LoopLbl, EndLbl, TopLbl] = create_lbls(3), [hipe_rtl:mk_load(OldByte, BaseDst, BothOffset, byte, unsigned), - hipe_rtl:mk_alu(Tmp1, hipe_rtl:mk_imm(?BYTE_SIZE), sub, InitOffset), + hipe_rtl:mk_alu(Tmp1, hipe_rtl:mk_imm(?BYTE_SIZE), sub, InitOffset), TopLbl, - hipe_rtl:mk_branch(BothOffset, ne, Iterations, - hipe_rtl:label_name(LoopLbl), + hipe_rtl:mk_branch(BothOffset, ne, Iterations, + hipe_rtl:label_name(LoopLbl), hipe_rtl:label_name(EndLbl)), - LoopLbl, + LoopLbl, hipe_rtl:mk_load(NewByte, BaseSrc, BothOffset, byte, unsigned), hipe_rtl:mk_alu(Tmp2, NewByte, srl, InitOffset), hipe_rtl:mk_alu(SaveByte, OldByte, 'or', Tmp2), @@ -1033,12 +1035,12 @@ initializations(BaseTmp1, BaseTmp2, BothOffset, CopyOffset, Offset, CopyBase, Ba copy_int_little(Base, Offset, NewOffset, Size, Tmp1) when is_integer(Size) -> [Tmp2,TmpOffset] = create_regs(2), - ByteSize = Size div ?BYTE_SIZE, - [hipe_rtl:mk_alu(TmpOffset, Offset, srl, ?BYTE_SHIFT), - hipe_rtl:mk_alu(Tmp2, hipe_rtl:mk_imm(ByteSize), 'add', TmpOffset)] ++ - + ByteSize = Size div ?BYTE_SIZE, + [hipe_rtl:mk_alu(TmpOffset, Offset, srl, ?BYTE_SHIFT), + hipe_rtl:mk_alu(Tmp2, hipe_rtl:mk_imm(ByteSize), 'add', TmpOffset)] ++ + little_loop(Tmp1, Tmp2, TmpOffset, Base) ++ - + case Size band 7 of 0 -> [hipe_rtl:mk_alu(NewOffset, Offset, 'add', hipe_rtl:mk_imm(Size))]; @@ -1047,18 +1049,16 @@ copy_int_little(Base, Offset, NewOffset, Size, Tmp1) when is_integer(Size) -> hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), hipe_rtl:mk_alu(NewOffset, Offset, 'add', hipe_rtl:mk_imm(Size))] end; - copy_int_little(Base, Offset, NewOffset, Size, Tmp1) -> [Tmp2, Tmp3, Tmp4, TmpOffset] = create_regs(4), - [hipe_rtl:mk_alu(Tmp2, Size, srl, ?BYTE_SHIFT), hipe_rtl:mk_alu(TmpOffset, Offset, srl, ?BYTE_SHIFT), hipe_rtl:mk_alu(Tmp3, Tmp2, 'add', TmpOffset)] ++ - + little_loop(Tmp1, Tmp3, TmpOffset, Base) ++ - + [hipe_rtl:mk_alu(Tmp4, Size, 'and', ?LOW_BITS), - hipe_rtl:mk_alu(Tmp4, hipe_rtl:mk_imm(?BYTE_SIZE), 'sub', Tmp4), + hipe_rtl:mk_alu(Tmp4, hipe_rtl:mk_imm(?BYTE_SIZE), 'sub', Tmp4), hipe_rtl:mk_alu(Tmp1, Tmp1, sll, Tmp4), hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), hipe_rtl:mk_alu(NewOffset, Offset, 'add', Size)]. @@ -1093,37 +1093,37 @@ copy_int_big(_Base, Offset, NewOffset, 0, _Tmp1) -> [hipe_rtl:mk_move(NewOffset, Offset)]; copy_int_big(Base, Offset, NewOffset, ?BYTE_SIZE, Tmp1) -> TmpOffset = hipe_rtl:mk_new_reg(), - [hipe_rtl:mk_alu(TmpOffset, Offset, 'srl', hipe_rtl:mk_imm(3)), - hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), - hipe_rtl:mk_alu(NewOffset, Offset, 'add', hipe_rtl:mk_imm(8))]; + [hipe_rtl:mk_alu(TmpOffset, Offset, 'srl', hipe_rtl:mk_imm(3)), + hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), + hipe_rtl:mk_alu(NewOffset, Offset, 'add', hipe_rtl:mk_imm(8))]; copy_int_big(Base, Offset, NewOffset, 2*?BYTE_SIZE, Tmp1) -> TmpOffset = hipe_rtl:mk_new_reg(), - [hipe_rtl:mk_alu(TmpOffset, Offset, 'srl', hipe_rtl:mk_imm(3)), - hipe_rtl:mk_alu(TmpOffset, TmpOffset, 'add', hipe_rtl:mk_imm(1)), - hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), - hipe_rtl:mk_alu(TmpOffset, TmpOffset, sub, hipe_rtl:mk_imm(1)), - hipe_rtl:mk_alu(Tmp1, Tmp1, 'sra', hipe_rtl:mk_imm(8)), - hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), - hipe_rtl:mk_alu(NewOffset, Offset, 'add', hipe_rtl:mk_imm(16))]; + [hipe_rtl:mk_alu(TmpOffset, Offset, 'srl', hipe_rtl:mk_imm(3)), + hipe_rtl:mk_alu(TmpOffset, TmpOffset, 'add', hipe_rtl:mk_imm(1)), + hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), + hipe_rtl:mk_alu(TmpOffset, TmpOffset, sub, hipe_rtl:mk_imm(1)), + hipe_rtl:mk_alu(Tmp1, Tmp1, 'sra', hipe_rtl:mk_imm(8)), + hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), + hipe_rtl:mk_alu(NewOffset, Offset, 'add', hipe_rtl:mk_imm(16))]; copy_int_big(Base, Offset, NewOffset, 3*?BYTE_SIZE, Tmp1) -> - TmpOffset = hipe_rtl:mk_new_reg(), - [hipe_rtl:mk_alu(TmpOffset, Offset, srl, hipe_rtl:mk_imm(3)), - hipe_rtl:mk_alu(TmpOffset, TmpOffset, add, hipe_rtl:mk_imm(2)), - hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), - hipe_rtl:mk_alu(TmpOffset, TmpOffset, sub, hipe_rtl:mk_imm(1)), - hipe_rtl:mk_alu(Tmp1, Tmp1, sra, hipe_rtl:mk_imm(8)), - hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), - hipe_rtl:mk_alu(TmpOffset, TmpOffset, sub, hipe_rtl:mk_imm(1)), - hipe_rtl:mk_alu(Tmp1, Tmp1, sra, hipe_rtl:mk_imm(8)), - hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), - hipe_rtl:mk_alu(NewOffset, Offset, add, hipe_rtl:mk_imm(24))]; + TmpOffset = hipe_rtl:mk_new_reg(), + [hipe_rtl:mk_alu(TmpOffset, Offset, srl, hipe_rtl:mk_imm(3)), + hipe_rtl:mk_alu(TmpOffset, TmpOffset, add, hipe_rtl:mk_imm(2)), + hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), + hipe_rtl:mk_alu(TmpOffset, TmpOffset, sub, hipe_rtl:mk_imm(1)), + hipe_rtl:mk_alu(Tmp1, Tmp1, sra, hipe_rtl:mk_imm(8)), + hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), + hipe_rtl:mk_alu(TmpOffset, TmpOffset, sub, hipe_rtl:mk_imm(1)), + hipe_rtl:mk_alu(Tmp1, Tmp1, sra, hipe_rtl:mk_imm(8)), + hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), + hipe_rtl:mk_alu(NewOffset, Offset, add, hipe_rtl:mk_imm(24))]; copy_int_big(Base, Offset,NewOffset, 4*?BYTE_SIZE, Tmp1) -> copy_big_word(Base, Offset, NewOffset, Tmp1); copy_int_big(Base, Offset, NewOffset, Size, Tmp1) when is_integer(Size) -> [OldOffset, TmpOffset, Bits] = create_regs(3), ByteSize = (Size + 7) div ?BYTE_SIZE, - case Size band 7 of - 0 -> + case Size band 7 of + 0 -> [hipe_rtl:mk_alu(OldOffset, Offset, sra, hipe_rtl:mk_imm(3)), hipe_rtl:mk_alu(TmpOffset, OldOffset, add, hipe_rtl:mk_imm(ByteSize))]; Rest -> @@ -1134,7 +1134,7 @@ copy_int_big(Base, Offset, NewOffset, Size, Tmp1) when is_integer(Size) -> hipe_rtl:mk_alu(Tmp1, Tmp1, sra, hipe_rtl:mk_imm(Rest))] end ++ big_loop(Tmp1, OldOffset, TmpOffset, Base) ++ - [hipe_rtl:mk_alu(NewOffset, Offset, 'add', hipe_rtl:mk_imm(Size))]; + [hipe_rtl:mk_alu(NewOffset, Offset, 'add', hipe_rtl:mk_imm(Size))]; copy_int_big(Base, Offset, NewOffset, Size, Tmp1) -> Tmp2 = hipe_rtl:mk_new_reg(), Tmp3 = hipe_rtl:mk_new_reg(), @@ -1147,7 +1147,7 @@ copy_int_big(Base, Offset, NewOffset, Size, Tmp1) -> [hipe_rtl:mk_alu(Tmp2, Size, 'srl', hipe_rtl:mk_imm(3)), hipe_rtl:mk_alu(Tmp3, Offset, 'srl', hipe_rtl:mk_imm(3)), hipe_rtl:mk_alu(TmpOffset, Tmp2, 'add', Tmp3), - hipe_rtl:mk_alub(Tmp4, Size, 'and', hipe_rtl:mk_imm(7), 'eq', + hipe_rtl:mk_alub(Tmp4, Size, 'and', hipe_rtl:mk_imm(7), 'eq', hipe_rtl:label_name(EvenLbl), hipe_rtl:label_name(OddLbl)), OddLbl, hipe_rtl:mk_alu(Tmp6, hipe_rtl:mk_imm(8), 'sub', Tmp4), @@ -1155,9 +1155,7 @@ copy_int_big(Base, Offset, NewOffset, Size, Tmp1) -> hipe_rtl:mk_store(Base, TmpOffset, Tmp5, byte), EvenLbl, hipe_rtl:mk_alu(Tmp1, Tmp1, srl, Tmp4)] ++ - big_loop(Tmp1, Tmp3, TmpOffset, Base) ++ - [hipe_rtl:mk_alu(NewOffset, Offset, 'add', Size)]. copy_big_word(Base, Offset, NewOffset, Word) -> @@ -1191,7 +1189,10 @@ copy_little_word(Base, Offset, NewOffset, Word) -> hipe_rtl:mk_store(Base, TmpOffset, Word, byte), hipe_rtl:mk_alu(NewOffset, Offset, 'add', hipe_rtl:mk_imm(32))]. -copy_offset_int_big(Base, Offset, NewOffset, Size, Tmp1) when is_integer(Size) -> +copy_offset_int_big(_Base, Offset, NewOffset, 0, _Tmp1) -> + [hipe_rtl:mk_move(NewOffset, Offset)]; +copy_offset_int_big(Base, Offset, NewOffset, Size, Tmp1) + when is_integer(Size), Size > 0 -> Tmp2 = hipe_rtl:mk_new_reg(), Tmp3 = hipe_rtl:mk_new_reg(), Tmp4 = hipe_rtl:mk_new_reg(), @@ -1202,7 +1203,7 @@ copy_offset_int_big(Base, Offset, NewOffset, Size, Tmp1) when is_integer(Size) - Tmp9 = hipe_rtl:mk_new_reg(), OldByte = hipe_rtl:mk_new_reg(), TmpOffset = hipe_rtl:mk_new_reg(), - BranchLbl = hipe_rtl:mk_new_label(), + BranchLbl = hipe_rtl:mk_new_label(), BodyLbl = hipe_rtl:mk_new_label(), EndLbl = hipe_rtl:mk_new_label(), NextLbl = hipe_rtl:mk_new_label(), @@ -1217,8 +1218,8 @@ copy_offset_int_big(Base, Offset, NewOffset, Size, Tmp1) when is_integer(Size) - hipe_rtl:mk_alu(Tmp6, Tmp6, 'and', ?LOW_BITS), hipe_rtl:mk_alu(Tmp4, hipe_rtl:mk_imm(?BYTE_SIZE), 'sub', Tmp6), hipe_rtl:mk_move(Tmp5, Tmp1), - hipe_rtl:mk_alu(Tmp1, Tmp1, 'sll', Tmp6), - hipe_rtl:mk_branch(TmpOffset, 'ne', Tmp3, hipe_rtl:label_name(NextLbl), + hipe_rtl:mk_alu(Tmp1, Tmp1, 'sll', Tmp6), + hipe_rtl:mk_branch(TmpOffset, 'ne', Tmp3, hipe_rtl:label_name(NextLbl), hipe_rtl:label_name(EndLbl)), NextLbl, hipe_rtl:mk_store(Base, TmpOffset, Tmp1, byte), @@ -1265,7 +1266,7 @@ copy_float_big(_Base, _Offset, _NewOffset, _Src, FalseLblName, _TrueLblName, fai copy_float_big(Base, Offset, NewOffset, Src, _FalseLblName, TrueLblName,pass) -> FloatLo = hipe_rtl:mk_new_reg(), FloatHi = hipe_rtl:mk_new_reg(), - TmpOffset =hipe_rtl:mk_new_reg(), + TmpOffset = hipe_rtl:mk_new_reg(), hipe_tagscheme:unsafe_load_float(FloatLo, FloatHi, Src) ++ copy_big_word(Base, Offset, TmpOffset, FloatHi) ++ copy_big_word(Base, TmpOffset, NewOffset, FloatLo) ++ @@ -1275,89 +1276,18 @@ copy_float_big(Base, Offset, NewOffset, Src, FalseLblName, TrueLblName, var) -> hipe_tagscheme:test_flonum(Src, hipe_rtl:label_name(SuccessLbl), FalseLblName, 0.99) ++ [SuccessLbl|copy_float_big(Base, Offset, NewOffset, Src, FalseLblName, TrueLblName, pass)]. -make_size(1, BitsVar, FalseLblName) -> - [DstReg] = create_regs(1), - {first_part(BitsVar, DstReg, FalseLblName), DstReg}; -make_size(?BYTE_SIZE, BitsVar, FalseLblName) -> - [DstReg] = create_regs(1), - Code = - first_part(BitsVar, DstReg, FalseLblName) ++ - [hipe_rtl:mk_alu(DstReg, DstReg, 'sll', ?BYTE_SHIFT)], - {Code, DstReg}; -make_size(UnitImm, BitsVar, FalseLblName) -> - [DstReg] = create_regs(1), - UnitList = number2list(UnitImm), - Code = multiply_code(UnitList, BitsVar, DstReg, FalseLblName), - {Code, DstReg}. - -multiply_code(List=[Head|_Tail], Variable, Result, FalseLblName) -> - Test = set_high(Head), - Tmp1 = hipe_rtl:mk_new_reg(), - SuccessLbl = hipe_rtl:mk_new_label(), - Register = hipe_rtl:mk_new_reg(), - Code = [hipe_rtl:mk_move(Result, hipe_rtl:mk_imm(0))| - first_part(Variable, Register, FalseLblName)] - ++ - [hipe_rtl:mk_alub(Tmp1, Register, 'and', hipe_rtl:mk_imm(Test), - 'eq', hipe_rtl:label_name(SuccessLbl), - FalseLblName, 0.99), - SuccessLbl], - multiply_code(List, Register, Result, FalseLblName, Tmp1, Code). - -multiply_code([ShiftSize|Rest], Register, Result, FalseLblName, Tmp1, OldCode) -> - SuccessLbl = hipe_rtl:mk_new_label(), - Code = OldCode ++ [hipe_rtl:mk_alu(Tmp1, Register, 'sll', - hipe_rtl:mk_imm(ShiftSize)), - hipe_rtl:mk_alub(Result, Tmp1, 'add', Result, not_overflow, hipe_rtl:label_name(SuccessLbl), FalseLblName, 0.99), - SuccessLbl], - multiply_code(Rest, Register, Result, FalseLblName, Tmp1, Code); -multiply_code([], _Register, _Result, _FalseLblName, _Tmp1, Code) -> - Code. - -number2list(X) when is_integer(X), X >= 0 -> - number2list(X, []). - -number2list(1, Acc) -> - lists:reverse([0|Acc]); -number2list(0, Acc) -> - lists:reverse(Acc); -number2list(X, Acc) -> - F = floorlog2(X), - number2list(X-(1 bsl F), [F|Acc]). - -floorlog2(X) -> - round(math:log(X)/math:log(2)-0.5). - -set_high(X) -> - set_high(X, 0). - -set_high(0, Y) -> - Y; -set_high(X, Y) -> - set_high(X-1, Y+(1 bsl (27-X))). - -get_32_bit_value(Size, USize, SystemLimitLblName, NegLblName) -> - Lbls = [FixLbl, BigLbl, OkLbl, PosBigLbl] = create_lbls(4), - [FixLblName, BigLblName, OkLblName, PosBigLblName] = [hipe_rtl:label_name(Lbl) || Lbl <- Lbls], - [hipe_tagscheme:test_fixnum(Size, FixLblName, BigLblName, 0.99), - FixLbl, - hipe_tagscheme:untag_fixnum(USize, Size), - hipe_rtl:mk_branch(USize, ge, hipe_rtl:mk_imm(0), OkLblName, NegLblName), - BigLbl, - hipe_tagscheme:test_pos_bignum(Size, PosBigLblName, NegLblName, 0.99), - PosBigLbl, - hipe_tagscheme:get_one_word_pos_bignum(USize, Size, SystemLimitLblName), - OkLbl]. - - -first_part(Var, Register, FalseLblName) -> - [SuccessLbl1, SuccessLbl2] = create_lbls(2), - [hipe_tagscheme:test_fixnum(Var, hipe_rtl:label_name(SuccessLbl1), - FalseLblName, 0.99), - SuccessLbl1, - hipe_tagscheme:fixnum_ge(Var, hipe_rtl:mk_imm(hipe_tagscheme:mk_fixnum(0)), - hipe_rtl:label_name(SuccessLbl2), FalseLblName, 0.99), - SuccessLbl2, - hipe_tagscheme:untag_fixnum(Register, Var)]. - - +is_divisible(_Dividend, 1, SuccLbl, _FailLbl) -> + [hipe_rtl:mk_goto(SuccLbl)]; +is_divisible(Dividend, Divisor, SuccLbl, FailLbl) -> + Log2 = hipe_rtl_binary:floorlog2(Divisor), + case Divisor =:= 1 bsl Log2 of + true -> %% Divisor is a power of 2 + %% Test that the Log2-1 lowest bits are clear + Mask = hipe_rtl:mk_imm(Divisor - 1), + [Tmp] = create_regs(1), + [hipe_rtl:mk_alub(Tmp, Dividend, 'and', Mask, eq, SuccLbl, FailLbl, 0.99)]; + false -> + %% We need division, fall back to a primop + [hipe_rtl:mk_call([], is_divisible, [Dividend, hipe_rtl:mk_imm(Divisor)], + SuccLbl, FailLbl, not_remote)] + end. diff --git a/lib/hipe/rtl/hipe_rtl_binary_match.erl b/lib/hipe/rtl/hipe_rtl_binary_match.erl index 8831199244..528672b893 100644 --- a/lib/hipe/rtl/hipe_rtl_binary_match.erl +++ b/lib/hipe/rtl/hipe_rtl_binary_match.erl @@ -2,18 +2,19 @@ %%% %%% %CopyrightBegin% %%% -%%% Copyright Ericsson AB 2007-2013. All Rights Reserved. +%%% Copyright Ericsson AB 2007-2016. All Rights Reserved. %%% -%%% The contents of this file are subject to the Erlang Public License, -%%% Version 1.1, (the "License"); you may not use this file except in -%%% compliance with the License. You should have received a copy of the -%%% Erlang Public License along with this software. If not, it can be -%%% retrieved online at http://www.erlang.org/. -%%% -%%% Software distributed under the License is distributed on an "AS IS" -%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%%% the License for the specific language governing rights and limitations -%%% under the License. +%%% Licensed under the Apache License, Version 2.0 (the "License"); +%%% you may not use this file except in compliance with the License. +%%% You may obtain a copy of the License at +%%% +%%% http://www.apache.org/licenses/LICENSE-2.0 +%%% +%%% Unless required by applicable law or agreed to in writing, software +%%% distributed under the License is distributed on an "AS IS" BASIS, +%%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%%% See the License for the specific language governing permissions and +%%% limitations under the License. %%% %%% %CopyrightEnd% %%% @@ -30,11 +31,12 @@ -import(hipe_tagscheme, [set_field_from_term/3, get_field_from_term/3]). +-import(hipe_rtl_binary, [make_size/3]). + -include("hipe_literals.hrl"). %%-------------------------------------------------------------------- --define(MAX_BINSIZE, trunc(?MAX_HEAP_BIN_SIZE / hipe_rtl_arch:word_size()) + 2). -define(BYTE_SHIFT, 3). %% Turn bits into bytes or vice versa -define(LOW_BITS, 7). %% Three lowest bits set -define(BYTE_SIZE, 8). @@ -180,17 +182,20 @@ gen_rtl({bs_get_binary, Size, Flags}, [Dst, NewMs], Args, [hipe_rtl:mk_goto(FalseLblName)]; false -> Unsafe = unsafe(Flags), - case Args of - [Ms] -> - SizeReg = hipe_rtl:mk_new_reg(), - SizeCode = [hipe_rtl:mk_move(SizeReg, hipe_rtl:mk_imm(Size))]; - [Ms, BitsVar] -> - {SizeCode, SizeReg} = make_size(Size, BitsVar, FalseLblName) - end, - InCode = get_binary(Dst, Ms, SizeReg, Unsafe, + {OldMs, SizeReg, SizeCode} = + case Args of + [Ms] -> + SzReg = hipe_rtl:mk_new_reg(), + SzCode = [hipe_rtl:mk_move(SzReg, hipe_rtl:mk_imm(Size))], + {Ms, SzReg, SzCode}; + [Ms, BitsVar] -> + {SzCode, SzReg} = make_size(Size, BitsVar, FalseLblName), + {Ms, SzReg, SzCode} + end, + InCode = get_binary(Dst, OldMs, SizeReg, Unsafe, TrueLblName, FalseLblName), [hipe_rtl:mk_gctest(?SUB_BIN_WORDSIZE)] ++ - update_ms(NewMs, Ms) ++ SizeCode ++ InCode + update_ms(NewMs, OldMs) ++ SizeCode ++ InCode end; %% ----- bs_get_utf8 ----- gen_rtl(bs_get_utf8, [Dst, NewMs], [Ms], TrueLblName, FalseLblName) -> @@ -229,14 +234,26 @@ gen_rtl({bs_skip_bits_all, Unit, _Flags}, Dst, [Ms], skip_bits_all(Unit, Ms, TrueLblName, FalseLblName); %% ----- bs_skip_bits ----- gen_rtl({bs_skip_bits, Bits}, Dst, [Ms|Args], TrueLblName, FalseLblName) -> + MaxValue = (1 bsl (hipe_rtl_arch:word_size() * ?BYTE_SIZE)), opt_update_ms(Dst, Ms) ++ - case Args of - [] -> - skip_bits2(Ms, hipe_rtl:mk_imm(Bits), TrueLblName, FalseLblName); - [Arg] -> - {SizeCode, SizeReg} = make_size(Bits, Arg, FalseLblName), - InCode = skip_bits2(Ms, SizeReg, TrueLblName, FalseLblName), - SizeCode ++ InCode + case Bits < MaxValue of + true -> + case Args of + [] -> + skip_bits2(Ms, hipe_rtl:mk_imm(Bits), TrueLblName, FalseLblName); + [Arg] -> + {SizeCode, SizeReg} = make_size(Bits, Arg, FalseLblName), + InCode = skip_bits2(Ms, SizeReg, TrueLblName, FalseLblName), + SizeCode ++ InCode + end; + false -> % handle overflow case + case Args of + [] -> + [hipe_rtl:mk_goto(FalseLblName)]; + [Arg] -> + [hipe_rtl:mk_branch(Arg, 'eq', hipe_tagscheme:mk_fixnum(0), + TrueLblName, FalseLblName, 0.5)] + end end; %% ----- bs_restore ----- gen_rtl({bs_restore, Slot}, [NewMs], [Ms], TrueLblName, _FalseLblName) -> @@ -317,32 +334,50 @@ float_get_c_code(Dst1, Ms, Size, Flags, TrueLblName, FalseLblName) -> get_c_code(Func, Dst1, Ms, Size, Flags, TrueLblName, FalseLblName) -> SizeReg = hipe_rtl:mk_new_reg_gcsafe(), FlagsReg = hipe_rtl:mk_new_reg_gcsafe(), + RetReg = hipe_rtl:mk_new_reg_gcsafe(), MatchBuf = hipe_rtl:mk_new_reg(), RetLabel = hipe_rtl:mk_new_label(), + OkLabel = hipe_rtl:mk_new_label(), NonVal = hipe_rtl:mk_imm(hipe_tagscheme:mk_non_value()), [hipe_rtl:mk_move(SizeReg, Size), hipe_rtl:mk_move(FlagsReg, hipe_rtl:mk_imm(Flags)), hipe_tagscheme:extract_matchbuffer(MatchBuf, Ms), - hipe_rtl_arch:call_bif([Dst1], Func, [SizeReg, FlagsReg, MatchBuf], + hipe_rtl_arch:call_bif([RetReg], Func, [SizeReg, FlagsReg, MatchBuf], hipe_rtl:label_name(RetLabel), FalseLblName), RetLabel, - hipe_rtl:mk_branch(Dst1, eq, NonVal, FalseLblName, TrueLblName, 0.01)]. + hipe_rtl:mk_branch(RetReg, eq, NonVal, FalseLblName, + hipe_rtl:label_name(OkLabel), 0.01), + OkLabel, + hipe_rtl:mk_move(Dst1, RetReg), + hipe_rtl:mk_goto(TrueLblName)]. utf8_get_c_code(Dst, Ms, TrueLblName, FalseLblName) -> + RetReg = hipe_rtl:mk_new_reg_gcsafe(), + OkLabel = hipe_rtl:mk_new_label(), MatchBuf = hipe_rtl:mk_new_reg(), NonVal = hipe_rtl:mk_imm(hipe_tagscheme:mk_non_value()), [hipe_tagscheme:extract_matchbuffer(MatchBuf, Ms), - hipe_rtl_arch:call_bif([Dst], bs_get_utf8, [MatchBuf], [], []), - hipe_rtl:mk_branch(Dst, eq, NonVal, FalseLblName, TrueLblName, 0.01)]. + hipe_rtl_arch:call_bif([RetReg], bs_get_utf8, [MatchBuf], [], []), + hipe_rtl:mk_branch(RetReg, eq, NonVal, FalseLblName, + hipe_rtl:label_name(OkLabel), 0.01), + OkLabel, + hipe_rtl:mk_move(Dst, RetReg), + hipe_rtl:mk_goto(TrueLblName)]. utf16_get_c_code(Flags, Dst, Ms, TrueLblName, FalseLblName) -> + RetReg = hipe_rtl:mk_new_reg_gcsafe(), + OkLabel = hipe_rtl:mk_new_label(), MatchBuf = hipe_rtl:mk_new_reg(), NonVal = hipe_rtl:mk_imm(hipe_tagscheme:mk_non_value()), FlagsReg = hipe_rtl:mk_new_reg_gcsafe(), [hipe_tagscheme:extract_matchbuffer(MatchBuf, Ms), hipe_rtl:mk_move(FlagsReg, hipe_rtl:mk_imm(Flags)), - hipe_rtl_arch:call_bif([Dst], bs_get_utf16, [MatchBuf, FlagsReg], [], []), - hipe_rtl:mk_branch(Dst, eq, NonVal, FalseLblName, TrueLblName, 0.01)]. + hipe_rtl_arch:call_bif([RetReg], bs_get_utf16, [MatchBuf, FlagsReg], [], []), + hipe_rtl:mk_branch(RetReg, eq, NonVal, FalseLblName, + hipe_rtl:label_name(OkLabel), 0.01), + OkLabel, + hipe_rtl:mk_move(Dst, RetReg), + hipe_rtl:mk_goto(TrueLblName)]. validate_unicode_retract_c_code(Src, Ms, TrueLblName, FalseLblName) -> MatchBuf = hipe_rtl:mk_new_reg(), @@ -697,13 +732,22 @@ get_binary_bytes(Binary, BinSize, Base, Offset, Orig, %%%%%%%%%%%%%%%%%%%%%%%%% UTILS %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% get_base(Orig,Base) -> - [HeapLbl,REFCLbl,EndLbl] = create_lbls(3), + [HeapLbl,REFCLbl,WritableLbl,NotWritableLbl,EndLbl] = create_lbls(5), + Flags = hipe_rtl:mk_new_reg_gcsafe(), + [hipe_tagscheme:test_heap_binary(Orig, hipe_rtl:label_name(HeapLbl), hipe_rtl:label_name(REFCLbl)), HeapLbl, hipe_rtl:mk_alu(Base, Orig, 'add', hipe_rtl:mk_imm(?HEAP_BIN_DATA-2)), hipe_rtl:mk_goto(hipe_rtl:label_name(EndLbl)), REFCLbl, + get_field_from_term({proc_bin, flags}, Orig, Flags), + hipe_rtl:mk_branch(Flags, 'ne', hipe_rtl:mk_imm(0), + hipe_rtl:label_name(WritableLbl), + hipe_rtl:label_name(NotWritableLbl)), + WritableLbl, + hipe_rtl:mk_call([], emasculate_binary, [Orig], [], [], 'not_remote'), + NotWritableLbl, hipe_rtl:mk_load(Base, Orig, hipe_rtl:mk_imm(?PROC_BIN_BYTES-2)), EndLbl]. @@ -792,10 +836,10 @@ create_lbls(0) -> create_lbls(X) when X > 0 -> [hipe_rtl:mk_new_label()|create_lbls(X-1)]. -make_dyn_prep(SizeReg, CCode) -> +make_dyn_prep(SizeReg, CCode) -> [CLbl, SuccessLbl] = create_lbls(2), - Init = [hipe_rtl:mk_branch(SizeReg, le, hipe_rtl:mk_imm(?MAX_SMALL_BITS), - hipe_rtl:label_name(SuccessLbl), + Init = [hipe_rtl:mk_branch(SizeReg, leu, hipe_rtl:mk_imm(?MAX_SMALL_BITS), + hipe_rtl:label_name(SuccessLbl), hipe_rtl:label_name(CLbl)), SuccessLbl], End = [CLbl|CCode], @@ -840,8 +884,8 @@ get_unaligned_int_to_reg(Reg, Size, Base, Offset, LowBits, Shiftr, Type) -> hipe_rtl:mk_imm((WordSize-MinLoad)*?BYTE_SIZE))]; {_, WordSize} -> UnsignedBig = {unsigned, big}, - [hipe_rtl:mk_branch(TotBits, le, hipe_rtl:mk_imm(MinLoad*?BYTE_SIZE), - hipe_rtl:label_name(LessLbl), + [hipe_rtl:mk_branch(TotBits, leu, hipe_rtl:mk_imm(MinLoad*?BYTE_SIZE), + hipe_rtl:label_name(LessLbl), hipe_rtl:label_name(MoreLbl)), LessLbl, load_bytes(LoadDst, Base, ByteOffset, Type, MinLoad), @@ -901,7 +945,7 @@ get_big_unknown_int(Dst1, Base, Offset, NewOffset, hipe_rtl:mk_alu(ByteOffset, Offset, srl, hipe_rtl:mk_imm(?BYTE_SHIFT)), load_bytes(LoadDst, Base, ByteOffset, Type, 1), BackLbl, - hipe_rtl:mk_branch(ByteOffset, le, Limit, hipe_rtl:label_name(LoopLbl), + hipe_rtl:mk_branch(ByteOffset, leu, Limit, hipe_rtl:label_name(LoopLbl), hipe_rtl:label_name(EndLbl)), LoopLbl, load_bytes(Tmp, Base, ByteOffset, {unsigned, big}, 1), @@ -930,8 +974,8 @@ get_little_unknown_int(Dst1, Base, Offset, NewOffset, hipe_rtl:mk_alu(Limit, Tmp, srl, hipe_rtl:mk_imm(?BYTE_SHIFT)), hipe_rtl:mk_move(ShiftReg, hipe_rtl:mk_imm(0)), BackLbl, - hipe_rtl:mk_branch(ByteOffset, lt, Limit, - hipe_rtl:label_name(LoopLbl), + hipe_rtl:mk_branch(ByteOffset, ltu, Limit, + hipe_rtl:label_name(LoopLbl), hipe_rtl:label_name(DoneLbl)), LoopLbl, load_bytes(Tmp, Base, ByteOffset, {unsigned, big}, 1), @@ -990,19 +1034,19 @@ unsigned_bignum(Dst1, Src, TrueLblName) -> hipe_tagscheme:unsafe_mk_big(Dst1, Src, unsigned), hipe_rtl:mk_goto(TrueLblName)]. -load_bytes(Dst, Base, Offset, {Signedness, _Endianess},1) -> +load_bytes(Dst, Base, Offset, {Signedness, _Endianness},1) -> [hipe_rtl:mk_load(Dst, Base, Offset, byte, Signedness), hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(1))]; -load_bytes(Dst, Base, Offset, {Signedness, Endianess},2) -> - case Endianess of +load_bytes(Dst, Base, Offset, {Signedness, Endianness},2) -> + case Endianness of big -> hipe_rtl_arch:load_big_2(Dst, Base, Offset, Signedness); little -> hipe_rtl_arch:load_little_2(Dst, Base, Offset, Signedness) end; -load_bytes(Dst, Base, Offset, {Signedness, Endianess},3) -> +load_bytes(Dst, Base, Offset, {Signedness, Endianness},3) -> Tmp1 = hipe_rtl:mk_new_reg(), - case Endianess of + case Endianness of big -> [hipe_rtl:mk_load(Dst, Base, Offset, byte, Signedness), hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(1)), @@ -1026,18 +1070,18 @@ load_bytes(Dst, Base, Offset, {Signedness, Endianess},3) -> hipe_rtl:mk_alu(Dst, Dst, 'or', Tmp1), hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(1))] end; -load_bytes(Dst, Base, Offset, {Signedness, Endianess}, 4) -> - case Endianess of +load_bytes(Dst, Base, Offset, {Signedness, Endianness}, 4) -> + case Endianness of big -> hipe_rtl_arch:load_big_4(Dst, Base, Offset, Signedness); little -> hipe_rtl_arch:load_little_4(Dst, Base, Offset, Signedness) end; -load_bytes(Dst, Base, Offset, {Signedness, Endianess}, X) when X > 1 -> +load_bytes(Dst, Base, Offset, {Signedness, Endianness}, X) when X > 1 -> [LoopLbl, EndLbl] = create_lbls(2), [Tmp1, Limit, TmpOffset] = create_regs(3), - case Endianess of + case Endianness of big -> [hipe_rtl:mk_alu(Limit, Offset, add, hipe_rtl:mk_imm(X)), hipe_rtl:mk_load(Dst, Base, Offset, byte, Signedness), @@ -1047,7 +1091,7 @@ load_bytes(Dst, Base, Offset, {Signedness, Endianess}, X) when X > 1 -> hipe_rtl:mk_alu(Offset, Offset, add, hipe_rtl:mk_imm(1)), hipe_rtl:mk_alu(Dst, Dst, sll, hipe_rtl:mk_imm(8)), hipe_rtl:mk_alu(Dst, Dst, 'or', Tmp1), - hipe_rtl:mk_branch(Offset, lt, Limit, hipe_rtl:label_name(LoopLbl), + hipe_rtl:mk_branch(Offset, ltu, Limit, hipe_rtl:label_name(LoopLbl), hipe_rtl:label_name(EndLbl)), EndLbl]; little -> @@ -1059,7 +1103,7 @@ load_bytes(Dst, Base, Offset, {Signedness, Endianess}, X) when X > 1 -> hipe_rtl:mk_load(Tmp1, Base, TmpOffset, byte, Signedness), hipe_rtl:mk_alu(Dst, Dst, sll, hipe_rtl:mk_imm(8)), hipe_rtl:mk_alu(Dst, Dst, 'or', Tmp1), - hipe_rtl:mk_branch(Offset, lt, TmpOffset, hipe_rtl:label_name(LoopLbl), + hipe_rtl:mk_branch(Offset, ltu, TmpOffset, hipe_rtl:label_name(LoopLbl), hipe_rtl:label_name(EndLbl)), EndLbl, hipe_rtl:mk_move(Offset, Limit)] @@ -1075,78 +1119,5 @@ create_gcsafe_regs(X) when X > 0 -> create_gcsafe_regs(0) -> []. -first_part(Var, Register, FalseLblName) -> - [SuccessLbl1, SuccessLbl2] = create_lbls(2), - [hipe_tagscheme:test_fixnum(Var, hipe_rtl:label_name(SuccessLbl1), - FalseLblName, 0.99), - SuccessLbl1, - hipe_tagscheme:fixnum_ge(Var, hipe_rtl:mk_imm(hipe_tagscheme:mk_fixnum(0)), - hipe_rtl:label_name(SuccessLbl2), FalseLblName, 0.99), - SuccessLbl2, - hipe_tagscheme:untag_fixnum(Register, Var)]. - -make_size(1, BitsVar, FalseLblName) -> - [DstReg] = create_regs(1), - {first_part(BitsVar, DstReg, FalseLblName), DstReg}; -make_size(?BYTE_SIZE, BitsVar, FalseLblName) -> - [DstReg] = create_regs(1), - Code = - first_part(BitsVar, DstReg, FalseLblName) ++ - [hipe_rtl:mk_alu(DstReg, DstReg, sll, hipe_rtl:mk_imm(?BYTE_SHIFT))], - {Code, DstReg}; -make_size(UnitImm, BitsVar, FalseLblName) -> - [DstReg] = create_regs(1), - UnitList = number2list(UnitImm), - Code = multiply_code(UnitList, BitsVar, DstReg, FalseLblName), - {Code, DstReg}. - -multiply_code(List=[Head|_Tail], Variable, Result, FalseLblName) -> - Test = set_high(Head), - Tmp1 = hipe_rtl:mk_new_reg(), - SuccessLbl = hipe_rtl:mk_new_label(), - Register = hipe_rtl:mk_new_reg(), - Code = [hipe_rtl:mk_move(Result, hipe_rtl:mk_imm(0))| - first_part(Variable, Register, FalseLblName)] - ++ - [hipe_rtl:mk_alub(Tmp1, Register, 'and', hipe_rtl:mk_imm(Test), - eq, hipe_rtl:label_name(SuccessLbl), - FalseLblName, 0.99), - SuccessLbl], - multiply_code(List, Register, Result, FalseLblName, Tmp1, Code). - -multiply_code([ShiftSize|Rest], Register, Result, FalseLblName, Tmp1, OldCode) -> - SuccessLbl = hipe_rtl:mk_new_label(), - Code = - OldCode ++ - [hipe_rtl:mk_alu(Tmp1, Register, sll, hipe_rtl:mk_imm(ShiftSize)), - hipe_rtl:mk_alub(Result, Tmp1, 'add', Result, not_overflow, - hipe_rtl:label_name(SuccessLbl), FalseLblName, 0.99), - SuccessLbl], - multiply_code(Rest, Register, Result, FalseLblName, Tmp1, Code); -multiply_code([], _Register, _Result, _FalseLblName, _Tmp1, Code) -> - Code. - -number2list(X) when is_integer(X), X >= 0 -> - number2list(X, []). - -number2list(1, Acc) -> - lists:reverse([0|Acc]); -number2list(0, Acc) -> - lists:reverse(Acc); -number2list(X, Acc) -> - F = floorlog2(X), - number2list(X-(1 bsl F), [F|Acc]). - -floorlog2(X) -> - round(math:log(X)/math:log(2)-0.5). - -set_high(X) -> - set_high(X, 0). - -set_high(0, Y) -> - Y; -set_high(X, Y) -> - set_high(X-1, Y+(1 bsl (27-X))). - is_illegal_const(Const) -> Const >= 1 bsl (hipe_rtl_arch:word_size() * ?BYTE_SIZE) orelse Const < 0. diff --git a/lib/hipe/rtl/hipe_rtl_cfg.erl b/lib/hipe/rtl/hipe_rtl_cfg.erl index b6c1d63262..f49e8f815f 100644 --- a/lib/hipe/rtl/hipe_rtl_cfg.erl +++ b/lib/hipe/rtl/hipe_rtl_cfg.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/rtl/hipe_rtl_cleanup_const.erl b/lib/hipe/rtl/hipe_rtl_cleanup_const.erl index d3e71a56c1..0a1cdbacb8 100644 --- a/lib/hipe/rtl/hipe_rtl_cleanup_const.erl +++ b/lib/hipe/rtl/hipe_rtl_cleanup_const.erl @@ -2,18 +2,19 @@ %%% %%% %CopyrightBegin% %%% -%%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %%% -%%% The contents of this file are subject to the Erlang Public License, -%%% Version 1.1, (the "License"); you may not use this file except in -%%% compliance with the License. You should have received a copy of the -%%% Erlang Public License along with this software. If not, it can be -%%% retrieved online at http://www.erlang.org/. -%%% -%%% Software distributed under the License is distributed on an "AS IS" -%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%%% the License for the specific language governing rights and limitations -%%% under the License. +%%% Licensed under the Apache License, Version 2.0 (the "License"); +%%% you may not use this file except in compliance with the License. +%%% You may obtain a copy of the License at +%%% +%%% http://www.apache.org/licenses/LICENSE-2.0 +%%% +%%% Unless required by applicable law or agreed to in writing, software +%%% distributed under the License is distributed on an "AS IS" BASIS, +%%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%%% See the License for the specific language governing permissions and +%%% limitations under the License. %%% %%% %CopyrightEnd% %%% diff --git a/lib/hipe/rtl/hipe_rtl_exceptions.erl b/lib/hipe/rtl/hipe_rtl_exceptions.erl index 879b84c0b0..331719f344 100644 --- a/lib/hipe/rtl/hipe_rtl_exceptions.erl +++ b/lib/hipe/rtl/hipe_rtl_exceptions.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/rtl/hipe_rtl_lcm.erl b/lib/hipe/rtl/hipe_rtl_lcm.erl index 262aedb409..71bd06c0df 100644 --- a/lib/hipe/rtl/hipe_rtl_lcm.erl +++ b/lib/hipe/rtl/hipe_rtl_lcm.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2011. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -62,10 +63,10 @@ rtl_lcm(CFG, Options) -> pp_debug("-------------------------------------------------~n",[]), %% pp_debug( "~w~n", [MFA]), - + %% A check if we should pretty print the result. case proplists:get_bool(pp_rtl_lcm, Options) of - true-> + true -> pp_debug("-------------------------------------------------~n",[]), %% pp_debug("AllExpr: ~w~n", [AllExpr]), pp_debug("AllExpr:~n", []), @@ -75,21 +76,21 @@ rtl_lcm(CFG, Options) -> _ -> ok end, - + pp_debug("-------------------------------------------------~n",[]), - ?option_time({CFG1, MoveSet} = perform_lcm(CFG, NodeInfo, EdgeInfo, ExprMap, - IdMap, AllExpr, mk_edge_bb_map(), + {CFG1, MoveSet} = ?option_time(perform_lcm(CFG, NodeInfo, EdgeInfo, ExprMap, + IdMap, AllExpr, mk_edge_bb_map(), ?SETS:new(), Labels), - "RTL LCM perform_lcm", Options), + "RTL LCM perform_lcm", Options), %% Scan through list of moved expressions and replace their %% assignments with the new temporary created for that expression MoveList = ?SETS:to_list(MoveSet), - ?option_time(CFG2 = moved_expr_replace_assignments(CFG1, ExprMap, IdMap, + CFG2 = ?option_time(moved_expr_replace_assignments(CFG1, ExprMap, IdMap, MoveList), - "RTL LCM moved_expr_replace_assignments", Options), + "RTL LCM moved_expr_replace_assignments", Options), pp_debug("-------------------------------------------------~n~n",[]), - + CFG2. %%============================================================================= @@ -465,10 +466,10 @@ expr_clear_dst(I) -> %% easy access later. lcm_precalc(CFG, Options) -> %% Calculate use map and expression map. - ?option_time({ExprMap, IdMap} = mk_expr_map(CFG), - "RTL LCM mk_expr_map", Options), - ?option_time(UseMap = mk_use_map(CFG, ExprMap), - "RTL LCM mk_use_map", Options), + {ExprMap, IdMap} = ?option_time(mk_expr_map(CFG), + "RTL LCM mk_expr_map", Options), + UseMap = ?option_time(mk_use_map(CFG, ExprMap), + "RTL LCM mk_use_map", Options), %% Labels = hipe_rtl_cfg:reverse_postorder(CFG), Labels = hipe_rtl_cfg:labels(CFG), %% StartLabel = hipe_rtl_cfg:start_label(CFG), @@ -476,28 +477,28 @@ lcm_precalc(CFG, Options) -> AllExpr = ?SETS:from_list(gb_trees:keys(IdMap)), %% Calculate the data sets. - ?option_time(NodeInfo0 = mk_node_info(Labels), "RTL LCM mk_node_info", - Options), + NodeInfo0 = ?option_time(mk_node_info(Labels), + "RTL LCM mk_node_info", Options), %% ?option_time(EdgeInfo0 = mk_edge_info(), "RTL LCM mk_edge_info", %% Options), EdgeInfo0 = mk_edge_info(), - ?option_time(NodeInfo1 = calc_up_exp(CFG, ExprMap, NodeInfo0, Labels), - "RTL LCM calc_up_exp", Options), - ?option_time(NodeInfo2 = calc_down_exp(CFG, ExprMap, NodeInfo1, Labels), - "RTL LCM calc_down_exp", Options), - ?option_time(NodeInfo3 = calc_killed_expr(CFG, NodeInfo2, UseMap, AllExpr, + NodeInfo1 = ?option_time(calc_up_exp(CFG, ExprMap, NodeInfo0, Labels), + "RTL LCM calc_up_exp", Options), + NodeInfo2 = ?option_time(calc_down_exp(CFG, ExprMap, NodeInfo1, Labels), + "RTL LCM calc_down_exp", Options), + NodeInfo3 = ?option_time(calc_killed_expr(CFG, NodeInfo2, UseMap, AllExpr, IdMap, Labels), - "RTL LCM calc_killed_exp", Options), - ?option_time(NodeInfo4 = calc_avail(CFG, NodeInfo3), - "RTL LCM calc_avail", Options), - ?option_time(NodeInfo5 = calc_antic(CFG, NodeInfo4, AllExpr), - "RTL LCM calc_antic", Options), - ?option_time(EdgeInfo1 = calc_earliest(CFG, NodeInfo5, EdgeInfo0, Labels), - "RTL LCM calc_earliest", Options), - ?option_time({NodeInfo6, EdgeInfo2} = calc_later(CFG, NodeInfo5, EdgeInfo1), - "RTL LCM calc_later", Options), - ?option_time(NodeInfo7 = calc_delete(CFG, NodeInfo6, Labels), - "RTL LCM calc_delete", Options), + "RTL LCM calc_killed_exp", Options), + NodeInfo4 = ?option_time(calc_avail(CFG, NodeInfo3), + "RTL LCM calc_avail", Options), + NodeInfo5 = ?option_time(calc_antic(CFG, NodeInfo4, AllExpr), + "RTL LCM calc_antic", Options), + EdgeInfo1 = ?option_time(calc_earliest(CFG, NodeInfo5, EdgeInfo0, Labels), + "RTL LCM calc_earliest", Options), + {NodeInfo6, EdgeInfo2} = ?option_time(calc_later(CFG, NodeInfo5, EdgeInfo1), + "RTL LCM calc_later", Options), + NodeInfo7 = ?option_time(calc_delete(CFG, NodeInfo6, Labels), + "RTL LCM calc_delete", Options), {NodeInfo7, EdgeInfo2, AllExpr, ExprMap, IdMap, Labels}. %%%%%%%%%%%%%%%%%%% AVAILABLE IN/OUT FLOW ANALYSIS %%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -940,15 +941,16 @@ calc_insert_edge(NodeInfo, EdgeInfo, From, To) -> calc_delete(_, NodeInfo, []) -> NodeInfo; calc_delete(CFG, NodeInfo, [Label|Labels]) -> - case Label =:= hipe_rtl_cfg:start_label(CFG) of - true -> - NewNodeInfo = set_delete(NodeInfo, Label, ?SETS:new()); - false -> - UpExp = up_exp(NodeInfo, Label), - LaterIn = later_in(NodeInfo, Label), - Delete = ?SETS:subtract(UpExp, LaterIn), - NewNodeInfo = set_delete(NodeInfo, Label, Delete) - end, + NewNodeInfo = + case Label =:= hipe_rtl_cfg:start_label(CFG) of + true -> + set_delete(NodeInfo, Label, ?SETS:new()); + false -> + UpExp = up_exp(NodeInfo, Label), + LaterIn = later_in(NodeInfo, Label), + Delete = ?SETS:subtract(UpExp, LaterIn), + set_delete(NodeInfo, Label, Delete) + end, calc_delete(CFG, NewNodeInfo, Labels). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% diff --git a/lib/hipe/rtl/hipe_rtl_liveness.erl b/lib/hipe/rtl/hipe_rtl_liveness.erl index 3cfada9d6c..674043ec3c 100644 --- a/lib/hipe/rtl/hipe_rtl_liveness.erl +++ b/lib/hipe/rtl/hipe_rtl_liveness.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -34,7 +35,8 @@ -module(hipe_rtl_liveness). -%% -define(LIVEOUT_NEEDED,true). % needed for liveness.inc below. +%% -define(DEBUG_LIVENESS,true). +-define(LIVEOUT_NEEDED,true). % needed for liveness.inc below. -define(PRETTY_PRINT,false). -include("hipe_rtl.hrl"). diff --git a/lib/hipe/rtl/hipe_rtl_mk_switch.erl b/lib/hipe/rtl/hipe_rtl_mk_switch.erl index d859c50b7d..5f9dffa8cf 100644 --- a/lib/hipe/rtl/hipe_rtl_mk_switch.erl +++ b/lib/hipe/rtl/hipe_rtl_mk_switch.erl @@ -1,19 +1,20 @@ -%% -*- coding: utf-8; erlang-indent-level: 2 -*- +%% -*- erlang-indent-level: 2 -*- %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2012. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/rtl/hipe_rtl_primops.erl b/lib/hipe/rtl/hipe_rtl_primops.erl index d9d08356ce..062fab842f 100644 --- a/lib/hipe/rtl/hipe_rtl_primops.erl +++ b/lib/hipe/rtl/hipe_rtl_primops.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2012. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/rtl/hipe_rtl_ssa.erl b/lib/hipe/rtl/hipe_rtl_ssa.erl index f55cc0dd5c..1e3b21d6be 100644 --- a/lib/hipe/rtl/hipe_rtl_ssa.erl +++ b/lib/hipe/rtl/hipe_rtl_ssa.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/rtl/hipe_rtl_ssa_avail_expr.erl b/lib/hipe/rtl/hipe_rtl_ssa_avail_expr.erl index cae6da542f..f08ff22ed9 100644 --- a/lib/hipe/rtl/hipe_rtl_ssa_avail_expr.erl +++ b/lib/hipe/rtl/hipe_rtl_ssa_avail_expr.erl @@ -1,18 +1,19 @@ %%% %%% %CopyrightBegin% %%% -%%% Copyright Ericsson AB 2007-2009. All Rights Reserved. +%%% Copyright Ericsson AB 2007-2016. All Rights Reserved. %%% -%%% The contents of this file are subject to the Erlang Public License, -%%% Version 1.1, (the "License"); you may not use this file except in -%%% compliance with the License. You should have received a copy of the -%%% Erlang Public License along with this software. If not, it can be -%%% retrieved online at http://www.erlang.org/. -%%% -%%% Software distributed under the License is distributed on an "AS IS" -%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%%% the License for the specific language governing rights and limitations -%%% under the License. +%%% Licensed under the Apache License, Version 2.0 (the "License"); +%%% you may not use this file except in compliance with the License. +%%% You may obtain a copy of the License at +%%% +%%% http://www.apache.org/licenses/LICENSE-2.0 +%%% +%%% Unless required by applicable law or agreed to in writing, software +%%% distributed under the License is distributed on an "AS IS" BASIS, +%%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%%% See the License for the specific language governing permissions and +%%% limitations under the License. %%% %%% %CopyrightEnd% %%% diff --git a/lib/hipe/rtl/hipe_rtl_ssa_const_prop.erl b/lib/hipe/rtl/hipe_rtl_ssa_const_prop.erl index 1c900d767e..7158383010 100644 --- a/lib/hipe/rtl/hipe_rtl_ssa_const_prop.erl +++ b/lib/hipe/rtl/hipe_rtl_ssa_const_prop.erl @@ -1,19 +1,20 @@ -%% -*- coding: utf-8; erlang-indent-level: 2 -*- +%% -*- erlang-indent-level: 2 -*- %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2012. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/rtl/hipe_rtl_ssapre.erl b/lib/hipe/rtl/hipe_rtl_ssapre.erl index 34897ba4b7..df1a4b9376 100644 --- a/lib/hipe/rtl/hipe_rtl_ssapre.erl +++ b/lib/hipe/rtl/hipe_rtl_ssapre.erl @@ -1,19 +1,20 @@ -%% -*- coding: utf-8; erlang-indent-level: 2 -*- +%% -*- erlang-indent-level: 2 -*- %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2012. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -106,7 +107,7 @@ rtl_ssapre(RtlSSACfg, Options) -> case XsiList of [] -> %% No Xsi - ?option_time(?pp_debug("~n~n################ No Xsi Inserted ################~n",[]),"RTL A-SSAPRE No Xsi inserted (skip Downsafety and Will Be Available)",Options), + ?pp_debug("~n~n################ No Xsi Inserted ################~n",[]), ok; _ -> ?pp_debug("~n############ Downsafety ##########~n",[]), @@ -125,7 +126,7 @@ rtl_ssapre(RtlSSACfg, Options) -> ?pp_debug("~n~n################ Xsi CFG ################~n",[]),pp_cfg(CFG2,XsiGraph), init_redundancy_count(), - ?option_time(FinalCFG=perform_code_motion(Labels,CFG2,XsiGraph),"RTL A-SSAPRE Code Motion",Options), + FinalCFG = ?option_time(perform_code_motion(Labels,CFG2,XsiGraph),"RTL A-SSAPRE Code Motion",Options), ?pp_debug("\n############ No more need for the Xsi Graph....Deleting...",[]),?GRAPH:delete(XsiGraph), @@ -145,7 +146,7 @@ perform_Xsi_insertion(Cfg, Options) -> init_counters(), %% Init counters for Bottoms and Temps DigraphOpts = [cyclic, private], XsiGraph = digraph:new(DigraphOpts), - %% Be carefull, the digraph component is NOT garbage collected, + %% Be careful, the digraph component is NOT garbage collected, %% so don't create 20 millions of instances! %% finds the longest depth %% Depth-first, preorder traversal over Basic Blocks. @@ -153,13 +154,13 @@ perform_Xsi_insertion(Cfg, Options) -> Labels = ?CFG:preorder(Cfg), ?pp_debug("~n~n############# Finding definitions for computation~n~n",[]), - ?option_time({Cfg2,XsiGraph} = find_definition_for_computations(Labels,Cfg,XsiGraph),"RTL A-SSAPRE Xsi Insertion, searching from instructions",Options), + {Cfg2,XsiGraph} = ?option_time(find_definition_for_computations(Labels,Cfg,XsiGraph),"RTL A-SSAPRE Xsi Insertion, searching from instructions",Options), %% Active List creation GeneratorXsiList = lists:sort(?GRAPH:vertices(XsiGraph)), ?pp_debug("~n~n############# Inserted Xsis ~w",[GeneratorXsiList]), ?pp_debug("~n~n############# Finding operands~n",[]), - ?option_time({Cfg3,XsiGraph} = find_operands(Cfg2,XsiGraph,GeneratorXsiList,0),"RTL A-SSAPRE Xsi Insertion, finding operands",Options), + {Cfg3,XsiGraph} = ?option_time(find_operands(Cfg2,XsiGraph,GeneratorXsiList,0),"RTL A-SSAPRE Xsi Insertion, finding operands",Options), %% Creating the CFGGraph ?pp_debug("~n~n############# Creating CFG Graph",[]), @@ -169,9 +170,9 @@ perform_Xsi_insertion(Cfg, Options) -> ?pp_debug("~nAdding a vertex for the start label: ~w",[StartLabel]), ?GRAPH:add_vertex(CFGGraph, StartLabel, #block{type = top}), % Doing the others - ?option_time(MPs=create_cfggraph(Others,Cfg3,CFGGraph,[],[],[],XsiGraph),"RTL A-SSAPRE Xsi Insertion, creating intermediate 'SSAPRE Graph'",Options), + MPs = ?option_time(create_cfggraph(Others,Cfg3,CFGGraph,[],[],[],XsiGraph),"RTL A-SSAPRE Xsi Insertion, creating intermediate 'SSAPRE Graph'",Options), - %% Return the bloody collected information + %% Return the collected information {Cfg3,XsiGraph,CFGGraph,MPs}. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -220,22 +221,21 @@ find_definition_for_computations_in_block(BlockLabel,[Inst|Rest],Cfg, ?pp_debug(" Inserting Xsi: ",[]),pp_xsi(Xsi), Label = Xsi#xsi.label, - case BlockLabel =:= Label of - false -> - %% Insert the Xsi in the appropriate block - Code = hipe_bb:code(?CFG:bb(Cfg,Label)), - {BeforeCode,AfterCode} = split_for_xsi(lists:reverse(Code),[]), - NewCode = BeforeCode++[XsiLink|AfterCode], - NewBB = hipe_bb:mk_bb(NewCode), - NewCfg = ?CFG:bb_add(Cfg,Label,NewBB), - NewVisited = [NewInst|VisitedInstructions]; - _-> - {BeforeCode,AfterCode} = split_for_xsi(VisitedInstructions,[]), - TempVisited = BeforeCode++[XsiLink|AfterCode], - TempVisited2 = lists:reverse(TempVisited), - NewVisited = [NewInst|TempVisited2], - NewCfg = Cfg - end, + {NewCfg, NewVisited} = + case BlockLabel =:= Label of + false -> + %% Insert the Xsi in the appropriate block + Code = hipe_bb:code(?CFG:bb(Cfg,Label)), + {BeforeCode,AfterCode} = split_for_xsi(lists:reverse(Code),[]), + NewCode = BeforeCode++[XsiLink|AfterCode], + NewBB = hipe_bb:mk_bb(NewCode), + {?CFG:bb_add(Cfg,Label,NewBB), [NewInst|VisitedInstructions]}; + _-> + {BeforeCode,AfterCode} = split_for_xsi(VisitedInstructions,[]), + TempVisited = BeforeCode++[XsiLink|AfterCode], + TempVisited2 = lists:reverse(TempVisited), + {Cfg, [NewInst|TempVisited2]} + end, find_definition_for_computations_in_block(BlockLabel, Rest, NewCfg, NewVisited, XsiGraph) end; @@ -786,14 +786,15 @@ create_cfggraph([Label|Ls],Cfg,CFGGraph,ToBeFactorizedAcc,MPAcc,LateEdges,XsiGra Defs = get_defs_in_non_merge_block(Code, []), ?pp_debug("~nAdding a vertex for ~w", [Label]), Succs = ?CFG:succ(Cfg, Label), - case Succs of - [] -> %% Exit point - ?GRAPH:add_vertex(CFGGraph, Label, #block{type = exit}), - NewToBeFactorizedAcc = ToBeFactorizedAcc; - _ -> %% Split point - ?GRAPH:add_vertex(CFGGraph,Label,#block{type=not_mp,attributes={P,Succs}}), - NewToBeFactorizedAcc = [Label|ToBeFactorizedAcc] - end, + NewToBeFactorizedAcc = + case Succs of + [] -> %% Exit point + ?GRAPH:add_vertex(CFGGraph, Label, #block{type = exit}), + ToBeFactorizedAcc; + _ -> %% Split point + ?GRAPH:add_vertex(CFGGraph,Label,#block{type=not_mp,attributes={P,Succs}}), + [Label|ToBeFactorizedAcc] + end, ?pp_debug("~nAdding an edge ~w -> ~w (~w)",[P,Label,Defs]), case ?GRAPH:add_edge(CFGGraph,P,Label,Defs) of {error,Reason} -> @@ -861,56 +862,53 @@ add_edges_for_mp([P|Ps], Label, LateEdges) -> %% Doesn't do anything so far add_map_and_uses([], _Key, Maps, Uses) -> - {Maps,Uses}; + {Maps, Uses}; add_map_and_uses([XsiOp|Ops], Key, Maps, Uses) -> - case XsiOp#xsi_op.op of - #bottom{} -> - Set = case gb_trees:lookup(XsiOp,Maps) of - {value, V} -> - ?SETS:add_element(Key,V); - none -> - ?SETS:from_list([Key]) - end, - NewMaps = gb_trees:enter(XsiOp,Set,Maps), - NewUses = Uses; - #temp{} -> - Set = case gb_trees:lookup(XsiOp,Maps) of - {value, V} -> - ?SETS:add_element(Key,V); - none -> - ?SETS:from_list([Key]) - end, - NewMaps = gb_trees:enter(XsiOp,Set,Maps), - Pred = XsiOp#xsi_op.pred, - OOP = XsiOp#xsi_op.op, - SSet = case gb_trees:lookup(Pred,Uses) of - {value, VV} -> - ?SETS:add_element(OOP#temp.key,VV); - none -> - ?SETS:from_list([OOP#temp.key]) - end, - NewUses = gb_trees:enter(Pred,SSet,Uses); - #eop{} -> - Set = case gb_trees:lookup(XsiOp,Maps) of - {value, V} -> - ?SETS:add_element(Key,V); - none -> - ?SETS:from_list([Key]) - end, - NewMaps = gb_trees:enter(XsiOp,Set,Maps), - Pred = XsiOp#xsi_op.pred, - Op = XsiOp#xsi_op.op, - SSet = case gb_trees:lookup(Pred,Uses) of - {value, VV} -> - ?SETS:add_element(Op#eop.stopped_by,VV); - none -> - ?SETS:from_list([Op#eop.stopped_by]) - end, - NewUses = gb_trees:enter(Pred,SSet,Uses); - _-> - NewMaps = Maps, - NewUses = Uses - end, + {NewMaps, NewUses} = + case XsiOp#xsi_op.op of + #bottom{} -> + Set = case gb_trees:lookup(XsiOp, Maps) of + {value, V} -> + ?SETS:add_element(Key, V); + none -> + ?SETS:from_list([Key]) + end, + {gb_trees:enter(XsiOp, Set, Maps), Uses}; + #temp{} -> + Set = case gb_trees:lookup(XsiOp, Maps) of + {value, V} -> + ?SETS:add_element(Key, V); + none -> + ?SETS:from_list([Key]) + end, + Pred = XsiOp#xsi_op.pred, + OOP = XsiOp#xsi_op.op, + SSet = case gb_trees:lookup(Pred, Uses) of + {value, VV} -> + ?SETS:add_element(OOP#temp.key, VV); + none -> + ?SETS:from_list([OOP#temp.key]) + end, + {gb_trees:enter(XsiOp, Set, Maps), gb_trees:enter(Pred, SSet, Uses)}; + #eop{} -> + Set = case gb_trees:lookup(XsiOp, Maps) of + {value, V} -> + ?SETS:add_element(Key, V); + none -> + ?SETS:from_list([Key]) + end, + Pred = XsiOp#xsi_op.pred, + Op = XsiOp#xsi_op.op, + SSet = case gb_trees:lookup(Pred, Uses) of + {value, VV} -> + ?SETS:add_element(Op#eop.stopped_by, VV); + none -> + ?SETS:from_list([Op#eop.stopped_by]) + end, + {gb_trees:enter(XsiOp, Set, Maps), gb_trees:enter(Pred, SSet, Uses)}; + _-> + {Maps, Uses} + end, add_map_and_uses(Ops, Key, NewMaps, NewUses). post_process([], _CFGGraph) -> ok; @@ -1161,37 +1159,38 @@ code_motion_in_block(L,[Inst|Insts],Cfg,XsiG,Visited,InsertionsAcc) -> #pre_candidate{} -> Def = Inst#pre_candidate.def, Alu = Inst#pre_candidate.alu, - case Def of - bottom -> - InstToAdd = Alu; - #temp{} -> - Key = Def#temp.key, - {_V,Xsi} = ?GRAPH:vertex(XsiG,Key), - case Xsi#xsi.wba of - true -> - %% Turn into a move - Dst = ?RTL:alu_dst(Alu), - Move = ?RTL:mk_move(Dst,Def#temp.var), - pp_instr(Inst#pre_candidate.alu,nil), ?pp_debug(" ==> ",[]), pp_instr(Move,nil), - %% Counting redundancies - redundancy_add(), - InstToAdd = Move; - _ -> - InstToAdd = Alu - end; - _ -> %% Def is a real variable - %% Turn into a move - Dst = ?RTL:alu_dst(Alu), - Move = ?RTL:mk_move(Dst,Def), - pp_instr(Alu,nil), ?pp_debug(" ==> ",[]), pp_instr(Move,nil), - %% Counting redundancies - redundancy_add(), - InstToAdd = Move - end, + InstToAdd = + case Def of + bottom -> + Alu; + #temp{} -> + Key = Def#temp.key, + {_V,Xsi} = ?GRAPH:vertex(XsiG,Key), + case Xsi#xsi.wba of + true -> + %% Turn into a move + Dst = ?RTL:alu_dst(Alu), + Move = ?RTL:mk_move(Dst,Def#temp.var), + pp_instr(Inst#pre_candidate.alu,nil), ?pp_debug(" ==> ",[]), pp_instr(Move,nil), + %% Counting redundancies + redundancy_add(), + Move; + _ -> + Alu + end; + _ -> %% Def is a real variable + %% Turn into a move + Dst = ?RTL:alu_dst(Alu), + Move = ?RTL:mk_move(Dst,Def), + pp_instr(Alu,nil), ?pp_debug(" ==> ",[]), pp_instr(Move,nil), + %% Counting redundancies + redundancy_add(), + Move + end, code_motion_in_block(L,Insts,Cfg,XsiG,[InstToAdd|Visited],InsertionsAcc); #xsi_link{} -> Key = Inst#xsi_link.num, - {_V,Xsi} = ?GRAPH:vertex(XsiG,Key), + {_V,Xsi} = ?GRAPH:vertex(XsiG,Key), case Xsi#xsi.wba of true -> %% Xsi is a WBA, it might trigger insertions @@ -1234,139 +1233,133 @@ get_insertions([],OpAcc,InsertionsAcc,_Visited,_Expr,_XsiG) -> get_insertions([XsiOp|Ops],OpAcc,InsertionsAcc,Visited,Expr,XsiG) -> Pred = XsiOp#xsi_op.pred, Op = XsiOp#xsi_op.op, - case Op of - #bottom{} -> - case gb_trees:lookup(Pred,InsertionsAcc) of - {value,Insertion} -> - From = Insertion#insertion.from, - case lists:keyfind(Op, 1, From) of - false -> - ?pp_debug("~nThere has been insertions along the edge L~w already, but not for that operand | Op=",[Pred]),pp_arg(Op), - Dst = Op#bottom.var, - Expr2 = ?RTL:alu_dst_update(Expr,Dst), - Inst = manufacture_computation(Pred,Expr2,Visited), - Code = Insertion#insertion.code, - NewInsertion = Insertion#insertion{from=[{Op,Dst}|From],code=[Inst|Code]}, - NewInsertionsAcc = gb_trees:update(Pred,NewInsertion,InsertionsAcc); - {_, Val} -> - ?pp_debug("~nThere has been insertions along the edge L~w already, and for that operand too | Op=",[Pred]),pp_arg(Op), - Dst = Val, - NewInsertionsAcc = InsertionsAcc - end; - none -> - ?pp_debug("~nThere has been no insertion along the edge L~w, (and not for that operand, of course)| Op=",[Pred]),pp_arg(Op), - Dst = Op#bottom.var, - Expr2 = ?RTL:alu_dst_update(Expr,Dst), - Inst = manufacture_computation(Pred,Expr2,Visited), - NewInsertion = #insertion{from=[{Op,Dst}],code=[Inst]}, - NewInsertionsAcc = gb_trees:insert(Pred,NewInsertion,InsertionsAcc) - end; - #const_expr{} -> - case gb_trees:lookup(Pred,InsertionsAcc) of - {value,Insertion} -> - From = Insertion#insertion.from, - case lists:keyfind(Op, 1, From) of - false -> - ?pp_debug("~nThere have been insertions along the edge L~w already, but not for that operand | Op=",[Pred]),pp_arg(Op), - Dst = Op#const_expr.var, - Val = Op#const_expr.value, - Inst = ?RTL:mk_move(Dst,Val), - Code = Insertion#insertion.code, - NewInsertion = Insertion#insertion{from=[{Op,Dst}|From],code=[Inst|Code]}, - NewInsertionsAcc = gb_trees:update(Pred,NewInsertion,InsertionsAcc); - {_, Val} -> - ?pp_debug("~nThere have been insertions along the edge L~w already, and for that operand too | Op=",[Pred]),pp_arg(Op), - Dst = Val, - NewInsertionsAcc = InsertionsAcc - end; - none -> - ?pp_debug("~nThere has been no insertion along the edge L~w, (and not for that operand, of course)| Op=",[Pred]),pp_arg(Op), - Dst = Op#const_expr.var, - Val = Op#const_expr.value, - Inst = ?RTL:mk_move(Dst,Val), - NewInsertion = #insertion{from=[{Op,Dst}],code=[Inst]}, - NewInsertionsAcc = gb_trees:insert(Pred,NewInsertion,InsertionsAcc) - end; - #eop{} -> - %% We treat expressions like bottoms - %% The value must be recomputed, and therefore not available... - case gb_trees:lookup(Pred,InsertionsAcc) of - {value,Insertion} -> - From = Insertion#insertion.from, - case lists:keyfind(Op, 1, From) of - false -> - ?pp_debug("~nThere has been insertions along the edge L~w already, but not for that operand | Op=",[Pred]),pp_arg(Op), - Dst = Op#eop.var, - Expr2 = ?RTL:alu_dst_update(Expr,Dst), - Inst = manufacture_computation(Pred,Expr2,Visited), - Code = Insertion#insertion.code, - NewInsertion = Insertion#insertion{from=[{Op,Dst}|From],code=[Inst|Code]}, - NewInsertionsAcc = gb_trees:update(Pred,NewInsertion,InsertionsAcc); - {_, Val} -> - ?pp_debug("~nThere has been insertions along the edge L~w already, and for that operand too | Op=",[Pred]),pp_arg(Op), - Dst = Val, - NewInsertionsAcc = InsertionsAcc - end; - none -> - ?pp_debug("~nThere has been no insertion along the edge L~w, (and not for that operand, of course)| Op=",[Pred]),pp_arg(Op), - Dst = Op#eop.var, - Expr2 = ?RTL:alu_dst_update(Expr,Dst), - Inst = manufacture_computation(Pred,Expr2,Visited), - NewInsertion = #insertion{from=[{Op,Dst}],code=[Inst]}, - NewInsertionsAcc = gb_trees:insert(Pred,NewInsertion,InsertionsAcc) - end; - #temp{} -> - case gb_trees:lookup(Pred,InsertionsAcc) of - {value,Insertion} -> - From = Insertion#insertion.from, - case lists:keyfind(Op, 1, From) of - false -> - ?pp_debug("~nThere has been insertions along the edge L~w already, but not for that operand | Op=",[Pred]),pp_arg(Op), - Key = Op#temp.key, - {_V,Xsi} = ?GRAPH:vertex(XsiG,Key), - case Xsi#xsi.wba of - true -> - ?pp_debug("~nBut the operand is a WBA Xsi: no need for insertion",[]), - Dst = Op#temp.var, - NewInsertionsAcc = InsertionsAcc; - _ -> - ?pp_debug("~nBut the operand is a NOT WBA Xsi: we must make an insertion",[]), - Dst = ?RTL:mk_new_var(), - Expr2 = ?RTL:alu_dst_update(Expr,Dst), - Inst = manufacture_computation(Pred,Expr2,Visited), - Code = Insertion#insertion.code, - NewInsertion = Insertion#insertion{from=[{Op,Dst}|From],code=[Inst|Code]}, - NewInsertionsAcc = gb_trees:update(Pred,NewInsertion,InsertionsAcc) - end; - {_, Val} -> - ?pp_debug("~nThere has been insertions along the edge L~w already, and for that operand too (Op=~w)",[Pred,Op]), - ?pp_debug("~nThis means, this temp is a WBA Xsi's definition",[]), - Dst = Val, - NewInsertionsAcc = InsertionsAcc - end; - none -> - ?pp_debug("~nThere has been no insertion along the edge L~w, (and not for that operand, of course | Op=",[Pred]),pp_arg(Op), - Key = Op#temp.key, - {_V,Xsi} = ?GRAPH:vertex(XsiG,Key), - case Xsi#xsi.wba of - true -> - ?pp_debug("~nBut the operand is a WBA Xsi: no need for insertion",[]), - Dst = Op#temp.var, - NewInsertionsAcc = InsertionsAcc; - _ -> - ?pp_debug("~nBut the operand is a NOT WBA Xsi: we must make an insertion",[]), - Dst = ?RTL:mk_new_var(), - Expr2 = ?RTL:alu_dst_update(Expr,Dst), - Inst = manufacture_computation(Pred,Expr2,Visited), - NewInsertion = #insertion{from=[{Op,Dst}],code=[Inst]}, - NewInsertionsAcc = gb_trees:insert(Pred,NewInsertion,InsertionsAcc) - end - end; - _ -> - ?pp_debug("~nThe operand (Op=",[]),pp_arg(Op),?pp_debug(") is a real variable, no need for insertion along L~w",[Pred]), - Dst = Op, - NewInsertionsAcc = InsertionsAcc - end, + {Dst, NewInsertionsAcc} = + case Op of + #bottom{} -> + case gb_trees:lookup(Pred,InsertionsAcc) of + {value,Insertion} -> + From = Insertion#insertion.from, + case lists:keyfind(Op, 1, From) of + false -> + ?pp_debug("~nThere has been insertions along the edge L~w already, but not for that operand | Op=",[Pred]),pp_arg(Op), + D = Op#bottom.var, + Expr2 = ?RTL:alu_dst_update(Expr,D), + Inst = manufacture_computation(Pred,Expr2,Visited), + Code = Insertion#insertion.code, + NewInsertion = Insertion#insertion{from=[{Op,D}|From],code=[Inst|Code]}, + {D, gb_trees:update(Pred, NewInsertion, InsertionsAcc)}; + {_, Val} -> + ?pp_debug("~nThere has been insertions along the edge L~w already, and for that operand too | Op=",[Pred]),pp_arg(Op), + {Val, InsertionsAcc} + end; + none -> + ?pp_debug("~nThere has been no insertion along the edge L~w, (and not for that operand, of course)| Op=",[Pred]),pp_arg(Op), + D = Op#bottom.var, + Expr2 = ?RTL:alu_dst_update(Expr, D), + Inst = manufacture_computation(Pred,Expr2,Visited), + NewInsertion = #insertion{from=[{Op,D}],code=[Inst]}, + {D, gb_trees:insert(Pred,NewInsertion, InsertionsAcc)} + end; + #const_expr{} -> + case gb_trees:lookup(Pred,InsertionsAcc) of + {value,Insertion} -> + From = Insertion#insertion.from, + case lists:keyfind(Op, 1, From) of + false -> + ?pp_debug("~nThere have been insertions along the edge L~w already, but not for that operand | Op=",[Pred]),pp_arg(Op), + D = Op#const_expr.var, + Val = Op#const_expr.value, + Inst = ?RTL:mk_move(D, Val), + Code = Insertion#insertion.code, + NewInsertion = Insertion#insertion{from=[{Op,D}|From],code=[Inst|Code]}, + {D, gb_trees:update(Pred,NewInsertion,InsertionsAcc)}; + {_, Val} -> + ?pp_debug("~nThere have been insertions along the edge L~w already, and for that operand too | Op=",[Pred]),pp_arg(Op), + {Val, InsertionsAcc} + end; + none -> + ?pp_debug("~nThere has been no insertion along the edge L~w, (and not for that operand, of course)| Op=",[Pred]),pp_arg(Op), + D = Op#const_expr.var, + Val = Op#const_expr.value, + Inst = ?RTL:mk_move(D, Val), + NewInsertion = #insertion{from=[{Op,D}],code=[Inst]}, + {D, gb_trees:insert(Pred,NewInsertion, InsertionsAcc)} + end; + #eop{} -> + %% We treat expressions like bottoms + %% The value must be recomputed, and therefore not available... + case gb_trees:lookup(Pred,InsertionsAcc) of + {value,Insertion} -> + From = Insertion#insertion.from, + case lists:keyfind(Op, 1, From) of + false -> + ?pp_debug("~nThere has been insertions along the edge L~w already, but not for that operand | Op=",[Pred]),pp_arg(Op), + D = Op#eop.var, + Expr2 = ?RTL:alu_dst_update(Expr, D), + Inst = manufacture_computation(Pred,Expr2,Visited), + Code = Insertion#insertion.code, + NewInsertion = Insertion#insertion{from=[{Op,D}|From],code=[Inst|Code]}, + {D, gb_trees:update(Pred,NewInsertion, InsertionsAcc)}; + {_, Val} -> + ?pp_debug("~nThere has been insertions along the edge L~w already, and for that operand too | Op=",[Pred]),pp_arg(Op), + {Val, InsertionsAcc} + end; + none -> + ?pp_debug("~nThere has been no insertion along the edge L~w, (and not for that operand, of course)| Op=",[Pred]),pp_arg(Op), + D = Op#eop.var, + Expr2 = ?RTL:alu_dst_update(Expr, D), + Inst = manufacture_computation(Pred,Expr2,Visited), + NewInsertion = #insertion{from=[{Op,D}],code=[Inst]}, + {D, gb_trees:insert(Pred, NewInsertion, InsertionsAcc)} + end; + #temp{} -> + case gb_trees:lookup(Pred,InsertionsAcc) of + {value,Insertion} -> + From = Insertion#insertion.from, + case lists:keyfind(Op, 1, From) of + false -> + ?pp_debug("~nThere has been insertions along the edge L~w already, but not for that operand | Op=",[Pred]),pp_arg(Op), + Key = Op#temp.key, + {_V,Xsi} = ?GRAPH:vertex(XsiG,Key), + case Xsi#xsi.wba of + true -> + ?pp_debug("~nBut the operand is a WBA Xsi: no need for insertion",[]), + {Op#temp.var, InsertionsAcc}; + _ -> + ?pp_debug("~nBut the operand is a NOT WBA Xsi: we must make an insertion",[]), + D = ?RTL:mk_new_var(), + Expr2 = ?RTL:alu_dst_update(Expr, D), + Inst = manufacture_computation(Pred,Expr2,Visited), + Code = Insertion#insertion.code, + NewInsertion = Insertion#insertion{from=[{Op,D}|From],code=[Inst|Code]}, + {D, gb_trees:update(Pred, NewInsertion, InsertionsAcc)} + end; + {_, Val} -> + ?pp_debug("~nThere has been insertions along the edge L~w already, and for that operand too (Op=~w)",[Pred,Op]), + ?pp_debug("~nThis means, this temp is a WBA Xsi's definition",[]), + {Val, InsertionsAcc} + end; + none -> + ?pp_debug("~nThere has been no insertion along the edge L~w, (and not for that operand, of course | Op=",[Pred]),pp_arg(Op), + Key = Op#temp.key, + {_V,Xsi} = ?GRAPH:vertex(XsiG,Key), + case Xsi#xsi.wba of + true -> + ?pp_debug("~nBut the operand is a WBA Xsi: no need for insertion",[]), + {Op#temp.var, InsertionsAcc}; + _ -> + ?pp_debug("~nBut the operand is a NOT WBA Xsi: we must make an insertion",[]), + D = ?RTL:mk_new_var(), + Expr2 = ?RTL:alu_dst_update(Expr, D), + Inst = manufacture_computation(Pred,Expr2,Visited), + NewInsertion = #insertion{from=[{Op,D}],code=[Inst]}, + {D, gb_trees:insert(Pred, NewInsertion, InsertionsAcc)} + end + end; + _ -> + ?pp_debug("~nThe operand (Op=",[]),pp_arg(Op),?pp_debug(") is a real variable, no need for insertion along L~w",[Pred]), + {Op, InsertionsAcc} + end, NewXsiOp = XsiOp#xsi_op{op=Dst}, get_insertions(Ops, [NewXsiOp|OpAcc], NewInsertionsAcc, Visited, Expr, XsiG). diff --git a/lib/hipe/rtl/hipe_rtl_symbolic.erl b/lib/hipe/rtl/hipe_rtl_symbolic.erl index bc8640dec9..1d7e0ec55e 100644 --- a/lib/hipe/rtl/hipe_rtl_symbolic.erl +++ b/lib/hipe/rtl/hipe_rtl_symbolic.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/rtl/hipe_rtl_varmap.erl b/lib/hipe/rtl/hipe_rtl_varmap.erl index 9bd5e88611..31165d91a4 100644 --- a/lib/hipe/rtl/hipe_rtl_varmap.erl +++ b/lib/hipe/rtl/hipe_rtl_varmap.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/rtl/hipe_tagscheme.erl b/lib/hipe/rtl/hipe_tagscheme.erl index f1e8d1ef41..8825a3ade3 100644 --- a/lib/hipe/rtl/hipe_tagscheme.erl +++ b/lib/hipe/rtl/hipe_tagscheme.erl @@ -2,25 +2,26 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2013. All Rights Reserved. +%% Copyright Ericsson AB 2001-2015. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% %%======================================================================== %% %% Filename : hipe_tagscheme.erl -%% Note : This is specific to Erlang 5.* (i.e. starting with R9). +%% Note : This is specific to Erlang >= 5.* (i.e. starting with R9). %% %% Modifications: %% 020904: Happi - added support for external pids and ports. @@ -39,23 +40,24 @@ test_tuple/4, test_atom/4, test_bignum/4, test_pos_bignum/4, test_any_pid/4, test_any_port/4, test_ref/4, test_fun/4, test_fun2/5, test_matchstate/4, - test_binary/4, test_bitstr/4, test_list/4, - test_integer/4, test_number/4, test_constant/4, test_tuple_N/5]). + test_binary/4, test_bitstr/4, test_list/4, test_map/4, + test_integer/4, test_number/4, test_tuple_N/5, + test_pos_bignum_arity/6]). -export([realtag_fixnum/2, tag_fixnum/2, realuntag_fixnum/2, untag_fixnum/2]). -export([test_two_fixnums/3, test_fixnums/4, unsafe_fixnum_add/3, unsafe_fixnum_sub/3, fixnum_gt/5, fixnum_lt/5, fixnum_ge/5, fixnum_le/5, fixnum_val/1, - fixnum_mul/4, - fixnum_addsub/5, fixnum_andorxor/4, fixnum_not/2, + fixnum_mul/4, fixnum_addsub/5, fixnum_andorxor/4, fixnum_not/2, fixnum_bsr/3, fixnum_bsl/3]). -export([unsafe_car/2, unsafe_cdr/2, unsafe_constant_element/3, unsafe_update_element/3, element/6]). -export([unsafe_closure_element/3]). -export([mk_fun_header/0, tag_fun/2]). -export([unsafe_untag_float/2, unsafe_tag_float/2]). --export([mk_sub_binary/6,mk_sub_binary/7]). +-export([mk_sub_binary/6, mk_sub_binary/7]). -export([unsafe_mk_big/3, unsafe_load_float/3]). --export([bignum_sizeneed/1,bignum_sizeneed_code/2, get_one_word_pos_bignum/3]). +-export([bignum_sizeneed/1, bignum_sizeneed_code/2, get_one_word_pos_bignum/3, + unsafe_get_one_word_pos_bignum/2]). -export([test_subbinary/3, test_heap_binary/3]). -export([create_heap_binary/3, create_refc_binary/3, create_refc_binary/4]). -export([create_matchstate/6, convert_matchstate/1, compare_matchstate/4]). @@ -113,13 +115,15 @@ -define(TAG_HEADER_EXTERNAL_PID, ((16#C bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_HEADER)). -define(TAG_HEADER_EXTERNAL_PORT,((16#D bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_HEADER)). -define(TAG_HEADER_EXTERNAL_REF, ((16#E bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_HEADER)). +-define(TAG_HEADER_MAP, ((16#F bsl ?TAG_PRIMARY_SIZE) bor ?TAG_PRIMARY_HEADER)). -define(TAG_HEADER_MASK, 16#3F). -define(HEADER_ARITY_OFFS, 6). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -mk_header(SZ,TAG) -> (SZ bsl ?HEADER_ARITY_OFFS) + TAG. +mk_header(SZ, TAG) -> (SZ bsl ?HEADER_ARITY_OFFS) + TAG. + mk_arityval(SZ) -> mk_header(SZ, ?TAG_HEADER_ARITYVAL). size_from_header(Sz, Header) -> @@ -133,14 +137,14 @@ mk_var_header(Header, Size, Tag) -> mk_fixnum(X) -> (X bsl ?TAG_IMMED1_SIZE) + ?TAG_IMMED1_SMALL. -define(NIL, ((-1 bsl ?TAG_IMMED2_SIZE) bor ?TAG_IMMED2_NIL)). -mk_nil() -> ?NIL. -%% mk_atom(X) -> (X bsl ?TAG_IMMED2_SIZE) + ?TAG_IMMED2_ATOM. -mk_non_value() -> ?THE_NON_VALUE. +mk_nil() -> ?NIL. +%% mk_atom(X) -> (X bsl ?TAG_IMMED2_SIZE) + ?TAG_IMMED2_ATOM. +mk_non_value() -> ?THE_NON_VALUE. -spec is_fixnum(integer()) -> boolean(). is_fixnum(N) when is_integer(N) -> Bits = ?bytes_to_bits(hipe_rtl_arch:word_size()) - ?TAG_IMMED1_SIZE, - (N =< ((1 bsl (Bits - 1)) - 1)) and (N >= -(1 bsl (Bits - 1))). + (N =< ((1 bsl (Bits - 1)) - 1)) andalso (N >= -(1 bsl (Bits - 1))). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% @@ -253,6 +257,15 @@ test_tuple_N(X, N, TrueLab, FalseLab, Pred) -> hipe_rtl:mk_branch(Tmp, 'eq', hipe_rtl:mk_imm(mk_arityval(N)), TrueLab, FalseLab, Pred)]. +test_map(X, TrueLab, FalseLab, Pred) -> + Tmp = hipe_rtl:mk_new_reg_gcsafe(), + HalfTrueLab = hipe_rtl:mk_new_label(), + MapMask = ?TAG_HEADER_MASK, + [test_is_boxed(X, hipe_rtl:label_name(HalfTrueLab), FalseLab, Pred), + HalfTrueLab, + get_header(Tmp, X), + mask_and_compare(Tmp, MapMask, ?TAG_HEADER_MAP, TrueLab, FalseLab, Pred)]. + test_ref(X, TrueLab, FalseLab, Pred) -> Hdr = hipe_rtl:mk_new_reg_gcsafe(), Tag = hipe_rtl:mk_new_reg_gcsafe(), @@ -338,6 +351,24 @@ test_pos_bignum(X, TrueLab, FalseLab, Pred) -> mask_and_compare(Tmp, BigMask, ?TAG_HEADER_POS_BIG, TrueLab, FalseLab, Pred)]. +test_pos_bignum_arity(X, Arity, TrueLab, NotPosBignumLab, FalseLab, Pred) -> + Tmp = hipe_rtl:mk_new_reg_gcsafe(), + BoxedLab = hipe_rtl:mk_new_label(), + HeaderImm = hipe_rtl:mk_imm(mk_header(Arity, ?TAG_HEADER_POS_BIG)), + [test_is_boxed(X, hipe_rtl:label_name(BoxedLab), NotPosBignumLab, Pred), + BoxedLab, + get_header(Tmp, X)] ++ + case NotPosBignumLab =:= FalseLab of + true -> []; + false -> + BignumLab = hipe_rtl:mk_new_label(), + BigMask = ?TAG_HEADER_MASK, + [mask_and_compare(Tmp, BigMask, ?TAG_HEADER_POS_BIG, + hipe_rtl:label_name(BignumLab), NotPosBignumLab, Pred), + BignumLab] + end ++ + [hipe_rtl:mk_branch(Tmp, 'eq', HeaderImm, TrueLab, FalseLab, Pred)]. + test_matchstate(X, TrueLab, FalseLab, Pred) -> Tmp = hipe_rtl:mk_new_reg_gcsafe(), HalfTrueLab = hipe_rtl:mk_new_label(), @@ -405,17 +436,6 @@ test_number(X, TrueLab, FalseLab, Pred) -> hipe_rtl:mk_branch(Tmp, 'eq', hipe_rtl:mk_imm(HeaderFlonum), TrueLab, FalseLab, Pred)]. -%% CONS, NIL, and TUPLE are not constants, everything else is -test_constant(X, TrueLab, FalseLab, Pred) -> - Lab1 = hipe_rtl:mk_new_label(), - Lab2 = hipe_rtl:mk_new_label(), - Pred1 = 1-Pred, - [test_cons(X, FalseLab, hipe_rtl:label_name(Lab1), Pred1), - Lab1, - test_nil(X, FalseLab, hipe_rtl:label_name(Lab2), Pred1), - Lab2, - test_tuple(X, FalseLab, TrueLab, Pred1)]. - %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% tag_fixnum(DestVar, SrcReg) -> @@ -963,22 +983,25 @@ get_one_word_pos_bignum(USize, Size, Fail) -> Header = hipe_rtl:mk_new_reg(), HalfLbl = hipe_rtl:mk_new_label(), HalfLblName = hipe_rtl:label_name(HalfLbl), - WordSize = hipe_rtl_arch:word_size(), PosHead = hipe_rtl:mk_imm(mk_header(1, ?TAG_HEADER_POS_BIG)), [get_header(Header, Size), hipe_rtl:mk_branch(Header, eq, PosHead, HalfLblName, Fail), - HalfLbl, - hipe_rtl:mk_load(USize, Size, hipe_rtl:mk_imm(1*WordSize - -?TAG_PRIMARY_BOXED))]. + HalfLbl | + unsafe_get_one_word_pos_bignum(USize, Size)]. + +unsafe_get_one_word_pos_bignum(USize, Size) -> + WordSize = hipe_rtl_arch:word_size(), + Imm = hipe_rtl:mk_imm(1*WordSize-?TAG_PRIMARY_BOXED), + [hipe_rtl:mk_load(USize, Size, Imm)]. -spec bignum_sizeneed(non_neg_integer()) -> non_neg_integer(). bignum_sizeneed(Size) -> - WordSizeBits = hipe_rtl_arch:word_size() * 8, case is_fixnum(1 bsl Size) of true -> 0; false -> + WordSizeBits = hipe_rtl_arch:word_size() * 8, ((Size + (WordSizeBits-1)) div WordSizeBits) + 1 end. @@ -1117,14 +1140,11 @@ get_field_offset({matchbuffer, binsize}) -> ?MB_SIZE. get_field_size(Field) -> - size_to_atom(get_field_size1(Field)). - -size_to_atom(Bytes) -> WordSize = hipe_rtl_arch:word_size(), - case Bytes of + case get_field_size1(Field) of WordSize -> word; - 4 -> int32; - %%2 -> int16; So far there are no 2 byte fields + %% 4 -> int32; Seems not needed: covered by the previous case + %% 2 -> int16; So far there are no 2 byte fields 1 -> byte end. diff --git a/lib/hipe/sparc/Makefile b/lib/hipe/sparc/Makefile index eb40117691..0e36a43d8e 100644 --- a/lib/hipe/sparc/Makefile +++ b/lib/hipe/sparc/Makefile @@ -1,18 +1,19 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2001-2012. All Rights Reserved. +# Copyright Ericsson AB 2001-2016. All Rights Reserved. # -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at # -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. # # %CopyrightEnd% # @@ -75,7 +76,7 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += +warn_exported_vars +ERL_COMPILE_FLAGS += -Werror +warn_export_vars # ---------------------------------------------------- # Targets diff --git a/lib/hipe/sparc/hipe_rtl_to_sparc.erl b/lib/hipe/sparc/hipe_rtl_to_sparc.erl index dc001f865e..eef5ba8d96 100644 --- a/lib/hipe/sparc/hipe_rtl_to_sparc.erl +++ b/lib/hipe/sparc/hipe_rtl_to_sparc.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2012. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -85,17 +86,17 @@ conv_insn(I, Map, Data) -> end. conv_fconv(I, Map, Data) -> - %% Dst := (double)Src, where Dst is FP reg and Src is int reg - {Src, Map1} = conv_src(hipe_rtl:fconv_src(I), Map), % exclude imm src + %% Dst := (double)Src, where Dst is FP reg and Src is GP reg or imm + {Src, Map1} = conv_src(hipe_rtl:fconv_src(I), Map), {Dst, Map2} = conv_fpreg(hipe_rtl:fconv_dst(I), Map1), I2 = mk_fconv(Src, Dst), {I2, Map2, Data}. mk_fconv(Src, Dst) -> CSP = hipe_sparc:mk_temp(14, 'untagged'), % o6 - Disp = hipe_sparc:mk_simm13(100), - [hipe_sparc:mk_store('stw', Src, CSP, Disp), - hipe_sparc:mk_pseudo_fload(CSP, Disp, Dst, true), + Offset = 100, + mk_store('stw', Src, CSP, Offset) ++ + [hipe_sparc:mk_pseudo_fload(CSP, hipe_sparc:mk_simm13(Offset), Dst, true), hipe_sparc:mk_fp_unary('fitod', Dst, Dst)]. conv_fmove(I, Map, Data) -> diff --git a/lib/hipe/sparc/hipe_sparc.erl b/lib/hipe/sparc/hipe_sparc.erl index 9fcb94afb6..5ecb6aa8b9 100644 --- a/lib/hipe/sparc/hipe_sparc.erl +++ b/lib/hipe/sparc/hipe_sparc.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/sparc/hipe_sparc.hrl b/lib/hipe/sparc/hipe_sparc.hrl index 107541f96a..01c8d07f22 100644 --- a/lib/hipe/sparc/hipe_sparc.hrl +++ b/lib/hipe/sparc/hipe_sparc.hrl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/sparc/hipe_sparc_assemble.erl b/lib/hipe/sparc/hipe_sparc_assemble.erl index b534fe20ec..e92f024968 100644 --- a/lib/hipe/sparc/hipe_sparc_assemble.erl +++ b/lib/hipe/sparc/hipe_sparc_assemble.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -45,10 +46,10 @@ assemble(CompiledCode, Closures, Exports, Options) -> print("Total num bytes=~w\n", [CodeSize], Options), %% SC = hipe_pack_constants:slim_constmap(ConstMap), - DataRelocs = mk_data_relocs(RefsFromConsts, LabelMap), - SSE = slim_sorted_exportmap(ExportMap,Closures,Exports), + DataRelocs = hipe_pack_constants:mk_data_relocs(RefsFromConsts, LabelMap), + SSE = hipe_pack_constants:slim_sorted_exportmap(ExportMap,Closures,Exports), SlimRefs = hipe_pack_constants:slim_refs(AccRefs), - Bin = term_to_binary([{?VERSION_STRING(),?HIPE_SYSTEM_CRC}, + Bin = term_to_binary([{?VERSION_STRING(),?HIPE_ERTS_CHECKSUM}, ConstAlign, ConstSize, SC, DataRelocs, % nee LM, LabelMap @@ -222,7 +223,7 @@ do_pseudo_set(I, MFA, ConstMap) -> %%% end, %%% {load_address, {Tag,untag_mfa_or_prim(MFAorPrim)}}; {Label,constant} -> - ConstNo = find_const({MFA,Label}, ConstMap), + ConstNo = hipe_pack_constants:find_const({MFA,Label}, ConstMap), {load_address, {constant,ConstNo}}; {Label,closure} -> {load_address, {closure,Label}}; @@ -507,37 +508,6 @@ px({pred,Pred}) -> % XXX: use pt/pn throughout entire backend %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -mk_data_relocs(RefsFromConsts, LabelMap) -> - lists:flatten(mk_data_relocs(RefsFromConsts, LabelMap, [])). - -mk_data_relocs([{MFA,Labels} | Rest], LabelMap, Acc) -> - Map = [case Label of - {L,Pos} -> - Offset = find({MFA,L}, LabelMap), - {Pos,Offset}; - {sorted,Base,OrderedLabels} -> - {sorted, Base, [begin - Offset = find({MFA,L}, LabelMap), - {Order, Offset} - end - || {L,Order} <- OrderedLabels]} - end - || Label <- Labels], - %% msg("Map: ~w Map\n",[Map]), - mk_data_relocs(Rest, LabelMap, [Map,Acc]); -mk_data_relocs([],_,Acc) -> Acc. - -find({_MFA,_L} = MFAL, LabelMap) -> - gb_trees:get(MFAL, LabelMap). - -slim_sorted_exportmap([{Addr,M,F,A}|Rest], Closures, Exports) -> - IsClosure = lists:member({M,F,A}, Closures), - IsExported = is_exported(F, A, Exports), - [Addr,M,F,A,IsClosure,IsExported | slim_sorted_exportmap(Rest, Closures, Exports)]; -slim_sorted_exportmap([],_,_) -> []. - -is_exported(F, A, Exports) -> lists:member({F,A}, Exports). - %%% %%% Assembly listing support (pp_asm option). %%% @@ -575,14 +545,3 @@ fill_spaces(N) when N > 0 -> fill_spaces(N-1); fill_spaces(0) -> []. - -%%% -%%% Lookup a constant in a ConstMap. -%%% - -find_const({MFA,Label},[{pcm_entry,MFA,Label,ConstNo,_,_,_}|_]) -> - ConstNo; -find_const(N,[_|R]) -> - find_const(N,R); -find_const(C,[]) -> - ?EXIT({constant_not_found,C}). diff --git a/lib/hipe/sparc/hipe_sparc_cfg.erl b/lib/hipe/sparc/hipe_sparc_cfg.erl index d938a3bdf1..0b2c77f27b 100644 --- a/lib/hipe/sparc/hipe_sparc_cfg.erl +++ b/lib/hipe/sparc/hipe_sparc_cfg.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/sparc/hipe_sparc_defuse.erl b/lib/hipe/sparc/hipe_sparc_defuse.erl index d59ad436b5..4f66299f1d 100644 --- a/lib/hipe/sparc/hipe_sparc_defuse.erl +++ b/lib/hipe/sparc/hipe_sparc_defuse.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/sparc/hipe_sparc_encode.erl b/lib/hipe/sparc/hipe_sparc_encode.erl index 8a28f33ab9..6a7d502fd3 100644 --- a/lib/hipe/sparc/hipe_sparc_encode.erl +++ b/lib/hipe/sparc/hipe_sparc_encode.erl @@ -2,18 +2,19 @@ %%% %%% %CopyrightBegin% %%% -%%% Copyright Ericsson AB 2007-2009. All Rights Reserved. +%%% Copyright Ericsson AB 2007-2016. All Rights Reserved. %%% -%%% The contents of this file are subject to the Erlang Public License, -%%% Version 1.1, (the "License"); you may not use this file except in -%%% compliance with the License. You should have received a copy of the -%%% Erlang Public License along with this software. If not, it can be -%%% retrieved online at http://www.erlang.org/. -%%% -%%% Software distributed under the License is distributed on an "AS IS" -%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%%% the License for the specific language governing rights and limitations -%%% under the License. +%%% Licensed under the Apache License, Version 2.0 (the "License"); +%%% you may not use this file except in compliance with the License. +%%% You may obtain a copy of the License at +%%% +%%% http://www.apache.org/licenses/LICENSE-2.0 +%%% +%%% Unless required by applicable law or agreed to in writing, software +%%% distributed under the License is distributed on an "AS IS" BASIS, +%%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%%% See the License for the specific language governing permissions and +%%% limitations under the License. %%% %%% %CopyrightEnd% %%% diff --git a/lib/hipe/sparc/hipe_sparc_finalise.erl b/lib/hipe/sparc/hipe_sparc_finalise.erl index b44a21f7c0..2b7125fb73 100644 --- a/lib/hipe/sparc/hipe_sparc_finalise.erl +++ b/lib/hipe/sparc/hipe_sparc_finalise.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/sparc/hipe_sparc_frame.erl b/lib/hipe/sparc/hipe_sparc_frame.erl index f7d7f40df3..a42c1983f4 100644 --- a/lib/hipe/sparc/hipe_sparc_frame.erl +++ b/lib/hipe/sparc/hipe_sparc_frame.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% Copyright Ericsson AB 2002-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/sparc/hipe_sparc_liveness_all.erl b/lib/hipe/sparc/hipe_sparc_liveness_all.erl index c6f78f9f7a..b7c3e1962a 100644 --- a/lib/hipe/sparc/hipe_sparc_liveness_all.erl +++ b/lib/hipe/sparc/hipe_sparc_liveness_all.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2009. All Rights Reserved. +%% Copyright Ericsson AB 2008-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/sparc/hipe_sparc_liveness_fpr.erl b/lib/hipe/sparc/hipe_sparc_liveness_fpr.erl index ac67e499ad..497c554c3e 100644 --- a/lib/hipe/sparc/hipe_sparc_liveness_fpr.erl +++ b/lib/hipe/sparc/hipe_sparc_liveness_fpr.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2009. All Rights Reserved. +%% Copyright Ericsson AB 2008-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/sparc/hipe_sparc_liveness_gpr.erl b/lib/hipe/sparc/hipe_sparc_liveness_gpr.erl index 0b07ae5c9d..55d639e3a2 100644 --- a/lib/hipe/sparc/hipe_sparc_liveness_gpr.erl +++ b/lib/hipe/sparc/hipe_sparc_liveness_gpr.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2007-2009. All Rights Reserved. +%% Copyright Ericsson AB 2007-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/sparc/hipe_sparc_main.erl b/lib/hipe/sparc/hipe_sparc_main.erl index 2e5c8e0494..c16751c7bd 100644 --- a/lib/hipe/sparc/hipe_sparc_main.erl +++ b/lib/hipe/sparc/hipe_sparc_main.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/sparc/hipe_sparc_pp.erl b/lib/hipe/sparc/hipe_sparc_pp.erl index 6b49acdd11..8fa0a9c788 100644 --- a/lib/hipe/sparc/hipe_sparc_pp.erl +++ b/lib/hipe/sparc/hipe_sparc_pp.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% Copyright Ericsson AB 2002-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/sparc/hipe_sparc_ra.erl b/lib/hipe/sparc/hipe_sparc_ra.erl index 40360e97fe..afea8c9b4c 100644 --- a/lib/hipe/sparc/hipe_sparc_ra.erl +++ b/lib/hipe/sparc/hipe_sparc_ra.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/sparc/hipe_sparc_ra_finalise.erl b/lib/hipe/sparc/hipe_sparc_ra_finalise.erl index 3403636118..dc1e69c101 100644 --- a/lib/hipe/sparc/hipe_sparc_ra_finalise.erl +++ b/lib/hipe/sparc/hipe_sparc_ra_finalise.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2009. All Rights Reserved. +%% Copyright Ericsson AB 2008-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/sparc/hipe_sparc_ra_ls.erl b/lib/hipe/sparc/hipe_sparc_ra_ls.erl index cdb15e738c..19e7c92d2f 100644 --- a/lib/hipe/sparc/hipe_sparc_ra_ls.erl +++ b/lib/hipe/sparc/hipe_sparc_ra_ls.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2009. All Rights Reserved. +%% Copyright Ericsson AB 2008-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/sparc/hipe_sparc_ra_naive.erl b/lib/hipe/sparc/hipe_sparc_ra_naive.erl index 8c378c4850..b6c33dec6c 100644 --- a/lib/hipe/sparc/hipe_sparc_ra_naive.erl +++ b/lib/hipe/sparc/hipe_sparc_ra_naive.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/sparc/hipe_sparc_ra_postconditions.erl b/lib/hipe/sparc/hipe_sparc_ra_postconditions.erl index f7fdae0491..ab31b3c8d9 100644 --- a/lib/hipe/sparc/hipe_sparc_ra_postconditions.erl +++ b/lib/hipe/sparc/hipe_sparc_ra_postconditions.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% Copyright Ericsson AB 2002-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/sparc/hipe_sparc_ra_postconditions_fp.erl b/lib/hipe/sparc/hipe_sparc_ra_postconditions_fp.erl index 17dc0f88d5..d893ac26e9 100644 --- a/lib/hipe/sparc/hipe_sparc_ra_postconditions_fp.erl +++ b/lib/hipe/sparc/hipe_sparc_ra_postconditions_fp.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2009. All Rights Reserved. +%% Copyright Ericsson AB 2008-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/sparc/hipe_sparc_registers.erl b/lib/hipe/sparc/hipe_sparc_registers.erl index adb01a65ca..884215702b 100644 --- a/lib/hipe/sparc/hipe_sparc_registers.erl +++ b/lib/hipe/sparc/hipe_sparc_registers.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/ssa/hipe_ssa.inc b/lib/hipe/ssa/hipe_ssa.inc index e766a83c41..83ab320306 100644 --- a/lib/hipe/ssa/hipe_ssa.inc +++ b/lib/hipe/ssa/hipe_ssa.inc @@ -1,19 +1,20 @@ -%% -*- coding: utf-8; erlang-indent-level: 2 -*- +%% -*- erlang-indent-level: 2 -*- %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2012. All Rights Reserved. +%% Copyright Ericsson AB 2002-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/ssa/hipe_ssa_const_prop.inc b/lib/hipe/ssa/hipe_ssa_const_prop.inc index 2fce384197..648490f9a3 100644 --- a/lib/hipe/ssa/hipe_ssa_const_prop.inc +++ b/lib/hipe/ssa/hipe_ssa_const_prop.inc @@ -3,18 +3,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -72,10 +73,10 @@ visit_expressions([Inst | Insts], Environment, FlowWork, SSAWork) -> %%----------------------------------------------------------------------------- -record(env, {cfg :: #cfg{}, - executable_flags = gb_sets:empty() :: gb_set(), - handled_blocks = gb_sets:empty() :: gb_set(), - lattice_values = gb_trees:empty() :: gb_tree(), - ssa_edges = gb_trees:empty() :: gb_tree() + executable_flags = gb_sets:empty() :: gb_sets:set(), + handled_blocks = gb_sets:empty() :: gb_sets:set(), + lattice_values = gb_trees:empty() :: gb_trees:tree(), + ssa_edges = gb_trees:empty() :: gb_trees:tree() }). create_env(CFG) -> diff --git a/lib/hipe/ssa/hipe_ssa_copy_prop.inc b/lib/hipe/ssa/hipe_ssa_copy_prop.inc index 311940a1fc..fd80d97b02 100644 --- a/lib/hipe/ssa/hipe_ssa_copy_prop.inc +++ b/lib/hipe/ssa/hipe_ssa_copy_prop.inc @@ -3,18 +3,19 @@ %%% %%% %CopyrightBegin% %%% -%%% Copyright Ericsson AB 2003-2009. All Rights Reserved. +%%% Copyright Ericsson AB 2003-2016. All Rights Reserved. %%% -%%% The contents of this file are subject to the Erlang Public License, -%%% Version 1.1, (the "License"); you may not use this file except in -%%% compliance with the License. You should have received a copy of the -%%% Erlang Public License along with this software. If not, it can be -%%% retrieved online at http://www.erlang.org/. -%%% -%%% Software distributed under the License is distributed on an "AS IS" -%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%%% the License for the specific language governing rights and limitations -%%% under the License. +%%% Licensed under the Apache License, Version 2.0 (the "License"); +%%% you may not use this file except in compliance with the License. +%%% You may obtain a copy of the License at +%%% +%%% http://www.apache.org/licenses/LICENSE-2.0 +%%% +%%% Unless required by applicable law or agreed to in writing, software +%%% distributed under the License is distributed on an "AS IS" BASIS, +%%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%%% See the License for the specific language governing permissions and +%%% limitations under the License. %%% %%% %CopyrightEnd% %%% diff --git a/lib/hipe/ssa/hipe_ssa_liveness.inc b/lib/hipe/ssa/hipe_ssa_liveness.inc index 05c8a88059..78488c65fc 100644 --- a/lib/hipe/ssa/hipe_ssa_liveness.inc +++ b/lib/hipe/ssa/hipe_ssa_liveness.inc @@ -3,18 +3,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/test/Makefile b/lib/hipe/test/Makefile new file mode 100644 index 0000000000..544888719f --- /dev/null +++ b/lib/hipe/test/Makefile @@ -0,0 +1,83 @@ +include $(ERL_TOP)/make/target.mk +include $(ERL_TOP)/make/$(TARGET)/otp.mk + +# ---------------------------------------------------- +# Target Specs +# ---------------------------------------------------- + +MODULES= \ + hipe_SUITE \ + opt_verify_SUITE + +# .erl files for these modules are automatically generated +GEN_MODULES= \ + basic_SUITE \ + bs_SUITE \ + maps_SUITE \ + sanity_SUITE + +ERL_FILES= $(MODULES:%=%.erl) + +TARGET_FILES= $(MODULES:%=$(EBIN)/%.$(EMULATOR)) +INSTALL_PROGS= $(TARGET_FILES) + +# ---------------------------------------------------- +# Files +# ---------------------------------------------------- +EMAKEFILE = Emakefile +AUXILIARY_FILES = hipe.spec hipe_testsuite_driver.erl $(EMAKEFILE) + +# ---------------------------------------------------- +# Release directory specification +# ---------------------------------------------------- +RELSYSDIR = $(RELEASE_PATH)/hipe_test + +# ---------------------------------------------------- +# FLAGS +# ---------------------------------------------------- + +ERL_MAKE_FLAGS += +ERL_COMPILE_FLAGS += + +EBIN = . + +# ---------------------------------------------------- +# Targets +# ---------------------------------------------------- + +make_emakefile: + $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) $(MODULES) \ + > $(EMAKEFILE) + $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) $(GEN_MODULES) \ + >> $(EMAKEFILE) + $(ERL_TOP)/make/make_emakefile $(ERL_COMPILE_FLAGS) -o$(EBIN) '*_SUITE_make' \ + >> $(EMAKEFILE) + +tests debug opt: make_emakefile + erl $(ERL_MAKE_FLAGS) -make + +clean: + rm -f $(EMAKEFILE) + rm -f $(TARGET_FILES) $(GEN_FILES) + rm -f core + +docs: + +# ---------------------------------------------------- +# Release Target +# ---------------------------------------------------- +include $(ERL_TOP)/make/otp_release_targets.mk + +release_spec: opt + +release_docs_spec: + +release_tests_spec: make_emakefile + $(INSTALL_DIR) "$(RELSYSDIR)" + chmod -R u+w "$(RELSYSDIR)" + $(INSTALL_DATA) $(AUXILIARY_FILES) "$(RELSYSDIR)" + $(INSTALL_DATA) $(ERL_FILES) "$(RELSYSDIR)" + @tar cf - *_SUITE_data | (cd "$(RELSYSDIR)"; tar xf -) + cd "$(RELSYSDIR)";\ + erlc hipe_testsuite_driver.erl;\ + erl -noshell -run hipe_testsuite_driver create_all_suites $(GEN_MODULES) -s erlang halt diff --git a/lib/hipe/test/basic_SUITE_data/basic_arith.erl b/lib/hipe/test/basic_SUITE_data/basic_arith.erl new file mode 100644 index 0000000000..28e99be053 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_arith.erl @@ -0,0 +1,72 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%--------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests cases for compilation of arithmetic. +%%%--------------------------------------------------------------------- +-module(basic_arith). + +-export([test/0]). + +test() -> + ok = test_rem(), + ok = test_bit_ops(), + ok = test_uplus(), + ok = test_bsl_errors(), + ok. + +%%---------------------------------------------------------------------- +%% Tests the remainder operator. + +test_rem() -> + 2 = ret_rem(42, 20), + -2 = ret_rem(-42, 20), + -2 = ret_rem(-42, -20), + {'EXIT', {badarith, _}} = ret_rem(3.14, 2), + {'EXIT', {badarith, _}} = ret_rem(42, 3.14), + ok. + +ret_rem(X, Y) -> + catch X rem Y. + +%%---------------------------------------------------------------------- +%% + +test_bit_ops() -> + 2 = bbb(11, 2, 16#3ff), + ok. + +bbb(X, Y, Z) -> + ((1 bsl X) bor Y) band Z. + +%%---------------------------------------------------------------------- +%% Tests unary plus: it used to be the identity function but not anymore + +test_uplus() -> + badarith = try uplus(gazonk) catch error:Err -> Err end, + 42 = uplus(42), + ok. + +uplus(X) -> +(X). + +%%---------------------------------------------------------------------- +%% The first part of this test triggered a bug in the emulator as one +%% of the arguments to bsl is not an integer. +%% +%% The second part triggered a compilation crash since an arithmetic +%% expression resulting in a 'system_limit' exception was statically +%% evaluated and an arithmetic result was expected. + +test_bsl_errors() -> + {'EXIT', {'badarith', _}} = (catch (t1(0, pad, 0))), + badarith = try t2(0, pad, 0) catch error:Err1 -> Err1 end, + system_limit = try (id(1) bsl 100000000) catch error:Err2 -> Err2 end, + ok. + +t1(_, X, _) -> + (1 bsl X) + 1. + +t2(_, X, _) -> + (X bsl 1) + 1. + +id(I) -> I. diff --git a/lib/hipe/test/basic_SUITE_data/basic_beam_instrs.erl b/lib/hipe/test/basic_SUITE_data/basic_beam_instrs.erl new file mode 100644 index 0000000000..6fafea3b09 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_beam_instrs.erl @@ -0,0 +1,102 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Tests for correct translation of various BEAM instructions. +%%%------------------------------------------------------------------- +-module(basic_beam_instrs). + +-export([test/0]). + +test() -> + ok = test_make_fun(), + ok = test_switch_val(), + ok = test_put_literal(), + ok = test_set_tuple_element(), + ok = test_unguarded_unsafe_element(), + ok. + +%%-------------------------------------------------------------------- +%% Tests whether the translation of make_fun works. + +test_make_fun() -> + {F, G} = double_the_fun(), + ok = F(), + {ok, 42} = G(42), + FV1 = {ok, free_var1}, + FV2 = {also, {free, var2}}, + {FV1, {ok, [bv]}, FV2} = contains_fun(FV1, ignored, FV2), + ok. + +double_the_fun() -> + {fun () -> ok end, fun (V) -> {ok, V} end}. + +contains_fun(X, _IGNORED_ARG, Y) -> + calls_fun(fun(Term) -> {X, Term, Y} end). + +calls_fun(F) -> + F({ok, [bv]}). + +%%-------------------------------------------------------------------- +%% Tests whether the translation of switch_val works. + +test_switch_val() -> + 'A' = sv(a), + 'B' = sv(b), + 'C' = sv(c), + foo = sv(d), + ok. + +sv(a) -> 'A'; +sv(b) -> 'B'; +sv(c) -> 'C'; +sv(_) -> foo. + +%%-------------------------------------------------------------------- +%% Tests correct handling of literals (statically constant terms) + +-define(QUADRUPLE, {a,b,c,42}). +-define(DEEP_LIST, [42,[42,[42]]]). + +test_put_literal() -> + ?QUADRUPLE = mk_literal_quadruple(), + ?DEEP_LIST = mk_literal_deep_list(), + ok. + +mk_literal_quadruple() -> + ?QUADRUPLE. + +mk_literal_deep_list() -> + ?DEEP_LIST. + +%%-------------------------------------------------------------------- +%% Tests whether the translation of set_tuple_element works. + +-record(rec, {f1, f2, f3, f4, f5}). + +test_set_tuple_element() -> + F2 = [a,b,c], F4 = {a,b}, + State0 = init_rec(F2, F4), + State1 = simple_set(State0, 42), + #rec{f1 = foo, f2 = F2, f3 = 42, f4 = F4, f5 = 42.0} = odd_set(State1, 21), + ok. + +init_rec(F2, F4) -> + #rec{f1 = bar, f2 = F2, f3 = 10, f4 = F4, f5 = 3.14}. + +simple_set(State, Val) -> %% f3 = Val is the one used in set_element; + State#rec{f3 = Val, f5 = Val*2}. %% this checks the case of variable + +odd_set(State, Val) -> %% f3 = foo is the one used in set_element; + State#rec{f1 = foo, f5 = Val*2.0}. %% this checks the case of constant + +%%-------------------------------------------------------------------- +%% Tests the handling of unguarded unsafe_element operations that BEAM +%% can sometimes construct on records (when it has enough context). + +test_unguarded_unsafe_element() -> + {badrecord, rec} = try unguarded_unsafe_element(42) catch error:E -> E end, + ok. + +unguarded_unsafe_element(X) -> + X#rec{f1 = X#rec.f3}. diff --git a/lib/hipe/test/basic_SUITE_data/basic_bifs.erl b/lib/hipe/test/basic_SUITE_data/basic_bifs.erl new file mode 100644 index 0000000000..e7ee2f3678 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_bifs.erl @@ -0,0 +1,257 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests for handling of BIFs in guards and body calls. +%%%------------------------------------------------------------------- +-module(basic_bifs). + +-export([test/0]). + +-define(BIG, 1398479237498374913984792374983749). + +test() -> + ok = test_abs(), + ok = test_binary_part(), + ok = test_element(), + ok = test_float(), + ok = test_float_to_list(), + ok = test_integer_to_list(), + ok = test_list_to_float(), + ok = test_list_to_integer(), + ok = test_round(), + ok = test_trunc(), + ok. + +%%-------------------------------------------------------------------- + +test_abs() -> + t_abs(5.5, 0.0, -100.0, 5, 0, -100, ?BIG). + +t_abs(F1, F2, F3, I1, I2, I3, BigNum) -> + %% Floats. + 5.5 = abs(F1), + 0.0 = abs(F2), + 100.0 = abs(F3), + %% Integers. + 5 = abs(I1), + 0 = abs(I2), + 100 = abs(I3), + %% Bignums. + BigNum = abs(BigNum), + BigNum = abs(-BigNum), + ok. + +%%-------------------------------------------------------------------- +%% Checks that 2-ary and 3-ary BIFs can be compiled to native code. + +test_binary_part() -> + Bin = <<1,2,3,4,5,6,7,8,9,10>>, + BinPart = bp3(Bin), + <<7,8>> = bp2(BinPart), + ok. + +bp2(Bin) -> + binary_part(Bin, {1, 2}). + +bp3(Bin) -> + binary_part(Bin, byte_size(Bin), -5). + +%%-------------------------------------------------------------------- + +test_element() -> + true = elem({a, b}), + false = elem({a, c}), + other = elem(gazonk), + ok. + +elem(T) when element(1, T) == a -> element(2, T) == b; +elem(_) -> other. + +%%-------------------------------------------------------------------- + +test_float() -> + t_float(0, 42, -100, 2.5, 0.0, -100.42, ?BIG, -?BIG). + +t_float(I1, I2, I3, F1, F2, F3, B1, B2) -> + 0.0 = float(I1), + 2.5 = float(F1), + 0.0 = float(F2), + -100.42 = float(F3), + 42.0 = float(I2), + -100.0 = float(I3), + %% Bignums. + 1398479237498374913984792374983749.0 = float(B1), + -1398479237498374913984792374983749.0 = float(B2), + %% Extremly big bignums. + Big = list_to_integer(duplicate(2000, $1)), + {'EXIT', _} = (catch float(Big)), + %% Invalid types and lists. + {'EXIT', _} = (catch my_list_to_integer(atom)), + {'EXIT', _} = (catch my_list_to_integer(123)), + {'EXIT', _} = (catch my_list_to_integer([$1, [$2]])), + {'EXIT', _} = (catch my_list_to_integer("1.2")), + {'EXIT', _} = (catch my_list_to_integer("a")), + {'EXIT', _} = (catch my_list_to_integer("")), + ok. + +my_list_to_integer(X) -> + list_to_integer(X). + +%%-------------------------------------------------------------------- + +test_float_to_list() -> + test_ftl("0.0e+0", 0.0), + test_ftl("2.5e+1", 25.0), + test_ftl("2.5e+0", 2.5), + test_ftl("2.5e-1", 0.25), + test_ftl("-3.5e+17", -350.0e15), + ok. + +test_ftl(Expect, Float) -> + %% No \n on the next line -- we want the line number from t_float_to_list. + Expect = remove_zeros(lists:reverse(float_to_list(Float)), []). + +%% Removes any non-significant zeros in a floating point number. +%% Example: 2.500000e+01 -> 2.5e+1 + +remove_zeros([$+, $e|Rest], [$0, X|Result]) -> + remove_zeros([$+, $e|Rest], [X|Result]); +remove_zeros([$-, $e|Rest], [$0, X|Result]) -> + remove_zeros([$-, $e|Rest], [X|Result]); +remove_zeros([$0, $.|Rest], [$e|Result]) -> + remove_zeros(Rest, [$., $0, $e|Result]); +remove_zeros([$0|Rest], [$e|Result]) -> + remove_zeros(Rest, [$e|Result]); +remove_zeros([Char|Rest], Result) -> + remove_zeros(Rest, [Char|Result]); +remove_zeros([], Result) -> + Result. + +%%-------------------------------------------------------------------- + +test_integer_to_list() -> + t_integer_to_list(0, 42, 32768, 268435455, 123456932798748738738). + +t_integer_to_list(I1, I2, I3, I4, BIG) -> + "0" = integer_to_list(I1), + "42" = integer_to_list(I2), + "-42" = integer_to_list(-I2), + "-42" = integer_to_list(-I2), + "32768" = integer_to_list(I3), + "268435455" = integer_to_list(I4), + "-268435455" = integer_to_list(-I4), + "123456932798748738738" = integer_to_list(BIG), + BigList = duplicate(2000, $1), + Big = list_to_integer(BigList), + BigList = integer_to_list(Big), + ok. + +%%-------------------------------------------------------------------- + +test_list_to_float() -> + ok = t_list_to_float_safe(), + ok = t_list_to_float_risky(). + +t_list_to_float_safe() -> + 0.0 = my_list_to_float("0.0"), + 0.0 = my_list_to_float("-0.0"), + 0.5 = my_list_to_float("0.5"), + -0.5 = my_list_to_float("-0.5"), + 100.0 = my_list_to_float("1.0e2"), + 127.5 = my_list_to_float("127.5"), + -199.5 = my_list_to_float("-199.5"), + {'EXIT', _} = (catch my_list_to_float("0")), + {'EXIT', _} = (catch my_list_to_float("0..0")), + {'EXIT', _} = (catch my_list_to_float("0e12")), + {'EXIT', _} = (catch my_list_to_float("--0.0")), + ok. + +my_list_to_float(X) -> + list_to_float(X). + +%% This might crash the emulator. (Used to crash Erlang 4.4.1 on Unix.) + +t_list_to_float_risky() -> + Many_Ones = duplicate(25000, $1), + ok = case list_to_float("2." ++ Many_Ones) of + F when is_float(F), 0.0 < F, F =< 3.14 -> ok + end, + {'EXIT', _} = (catch list_to_float("2" ++ Many_Ones)), + ok. + +%%-------------------------------------------------------------------- + +test_list_to_integer() -> + ok = t_list_to_integer_small("0", "00", "-0", "1", "-1", "42", "-12", + "32768", "268435455", "-268435455"), + ok = t_list_to_integer_bignum("123456932798748738738666"), + ok. + +t_list_to_integer_small(S1, S2, S3, S4, S5, S6, S7, S8, S9, S10) -> + 0 = list_to_integer(S1), + 0 = list_to_integer(S2), + 0 = list_to_integer(S3), + 1 = list_to_integer(S4), + -1 = list_to_integer(S5), + 42 = list_to_integer(S6), + -12 = list_to_integer(S7), + 32768 = list_to_integer(S8), + 268435455 = list_to_integer(S9), + -268435455 = list_to_integer(S10), + ok. + +t_list_to_integer_bignum(S) -> + 123456932798748738738666 = list_to_integer(S), + case list_to_integer(duplicate(2000, $1)) of + I when is_integer(I), I > 123456932798748738738666 -> ok + end. + +%%-------------------------------------------------------------------- + +test_round() -> + ok = t_round_small(0.0, 0.4, 0.5, -0.4, -0.5, 255.3, 255.6, -1033.3, -1033.6), + ok = t_round_big(4294967296.1, 4294967296.9), + ok. + +t_round_small(F1, F2, F3, F4, F5, F6, F7, F8, F9) -> + 0 = round(F1), + 0 = round(F2), + 1 = round(F3), + 0 = round(F4), + -1 = round(F5), + 255 = round(F6), + 256 = round(F7), + -1033 = round(F8), + -1034 = round(F9), + ok. + +t_round_big(B1, B2) -> + 4294967296 = round(B1), + 4294967297 = round(B2), + -4294967296 = round(-B1), + -4294967297 = round(-B2), + ok. + +%%-------------------------------------------------------------------- + +test_trunc() -> + t_trunc(0.0, 5.3333, -10.978987, 4294967305.7). + +t_trunc(F1, F2, F3, B) -> + 0 = trunc(F1), + 5 = trunc(F2), + -10 = trunc(F3), + %% Bignums. + 4294967305 = trunc(B), + -4294967305 = trunc(-B), + ok. + +%%-------------------------------------------------------------------- +%% Auxiliary functions below + +duplicate(N, X) when is_integer(N), N >= 0 -> + duplicate(N, X, []). + +duplicate(0, _, L) -> L; +duplicate(N, X, L) -> duplicate(N-1, X, [X|L]). diff --git a/lib/hipe/test/basic_SUITE_data/basic_bignums.erl b/lib/hipe/test/basic_SUITE_data/basic_bignums.erl new file mode 100644 index 0000000000..e3b523b3f5 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_bignums.erl @@ -0,0 +1,143 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains code examples that test bignum arithmetic and matching. +%%%------------------------------------------------------------------- +-module(basic_bignums). + +-export([test/0, test_bsl/0]). + +test() -> + ok = test_ops(), + ok = test_big_fac(), + ok = test_int_overfl_32(), + ok = test_int_overfl_64(), + ok = test_int_overfl_32_guard(), + ok = test_int_overfl_64_guard(), + ok. + +%%-------------------------------------------------------------------- +%% Define some constants for the tests of arithmetic operators + +-define(X, 68719476736). +-define(Y, 98765432101234). +-define(Z, 4722366482869645213696). +-define(W, 339254531512339254531512). + +-define(B1, 4398046511104). +-define(B5, 1645504557321206042154969182557350504982735865633579863348609024). +-define(B17, 86182066610968551542636378241108028056376767329454880514019834315878107616003372189510312530372009184902888961739623919010110377987011442493486117202360415845666384627768436296772219009176743399772868636439042064384). + +%%-------------------------------------------------------------------- + +test_ops() -> + ok = test_mult(), + ok = test_div(), + ok = test_round(), + ok = test_trunc(), + ok = test_bsl(), + ok. + +test_mult() -> + ?Z = mult(?X, ?X), + ok. + +mult(X, Y) -> X * Y. + +test_div() -> + 4 = div_f(339254531512, ?X), + 0 = div_f(?Y, ?Y+1), + 64 = div_f(?B1, ?X), + ?X = div_f(?Z, ?X), + 1073741824 = div_f(?Z, ?B1), + ok. + +div_f(X, Y) -> X div Y. + +test_round() -> + 0 = round_f(?Z, ?W), + 1 = round_f(?Y, ?Y), + 71 = round_f(?W, ?Z), + 1437 = round_f(?Y, ?X), + 47813960 = round_f(?Z, ?Y), + 4936803183406 = round_f(?W, ?X), + ok. + +trunc_f(X, Y) -> round(X/Y). + +test_trunc() -> + 0 = trunc_f(?Z, ?W), + 1 = trunc_f(?Y, ?Y), + 72 = trunc_f(?W, ?Z), + 1437 = trunc_f(?Y, ?X), + 47813961 = trunc_f(?Z, ?Y), + 4936803183407 = trunc_f(?W, ?X), + ok. + +round_f(X, Y) -> trunc(X/Y). + +test_bsl() -> + ?B1 = bsl_f(1, 42), + ?B5 = n(5, fun erlang:'bsl'/2, 1, 42), % use the operator + ?B17 = n(17, fun bsl_f/2, 1, 42), % use the local function + ok. + +bsl_f(X, Y) -> X bsl Y. + +%% applies a binary function N times +n(1, F, X, Y) -> F(X, Y); +n(N, F, X, Y) when N > 1 -> n(N-1, F, F(X, Y), Y). + +%%-------------------------------------------------------------------- + +-define(FAC42, 1405006117752879898543142606244511569936384000000000). + +test_big_fac() -> + ?FAC42 = fac(42), + ok. + +fac(0) -> 1; +fac(N) -> N * fac(N-1). + +%%-------------------------------------------------------------------- +%% Tests for correct handling of integer overflow + +test_int_overfl_32() -> + 16#7FFFFFF = add(16#7FFFFFF, 0), + 16#8000000 = add(16#8000000, 0), + 16#8000001 = add(16#8000000, 1), + case add(16#7FFFFFF, 1) of + 16#8000000 -> ok; + -16#7FFFFFF -> error + end. + +test_int_overfl_64() -> + 16#7FFFFFFFFFFFFFF = add(16#7FFFFFFFFFFFFFF, 0), + 16#800000000000000 = add(16#800000000000000, 0), + 16#800000000000001 = add(16#800000000000000, 1), + case add(16#7FFFFFFFFFFFFFF, 1) of + 16#800000000000000 -> ok; + -16#7FFFFFFFFFFFFFF -> error + end. + +add(X, Y) -> X + Y. + +%%-------------------------------------------------------------------- +%% Tests for correct handling of integer overflow in guards + +test_int_overfl_32_guard() -> + ok = overfl_in_guard(16#7ffffff, 0), + ok = overfl_in_guard(16#7ffffff, 16#7ffffff), + ok. + +test_int_overfl_64_guard() -> + ok = overfl_in_guard(16#7ffffffffffffff, 0), + ok = overfl_in_guard(16#7ffffffffffffff, 16#7ffffffffffffff), + ok. + +overfl_in_guard(X, Y) -> + case ok of + V when X+Y > 12 -> V; + _ -> bad + end. diff --git a/lib/hipe/test/basic_SUITE_data/basic_boolean.erl b/lib/hipe/test/basic_SUITE_data/basic_boolean.erl new file mode 100644 index 0000000000..e4a91ef5af --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_boolean.erl @@ -0,0 +1,47 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Tests for correct translation of booleans and their primitives. +%%%------------------------------------------------------------------- +-module(basic_boolean). + +-export([test/0]). + +test() -> + ok = test_boolean_ops(false, true), + ok = test_orelse_redundant(), + ok. + +%%-------------------------------------------------------------------- + +test_boolean_ops(F, T) -> + true = T and T, + false = T and F, + false = F and T, + false = F and F, + true = T or T, + true = T or F, + true = F or T, + false = F or F, + true = T andalso T, + false = T andalso F, + false = F andalso T, + false = F andalso F, + true = T orelse T, + true = T orelse F, + true = F orelse T, + false = F orelse F, + ok. + +%%-------------------------------------------------------------------- +%% Redundant test in BEAM code will generate type warning. + +test_orelse_redundant() -> + true = test_orelse(true, true, true), + ok. + +test_orelse(A, B, C) -> + A andalso B orelse C. + +%%-------------------------------------------------------------------- diff --git a/lib/hipe/test/basic_SUITE_data/basic_bugs_beam.erl b/lib/hipe/test/basic_SUITE_data/basic_bugs_beam.erl new file mode 100644 index 0000000000..964b0f423a --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_bugs_beam.erl @@ -0,0 +1,138 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains code examples that exhibited bugs in the BEAM compiler. +%%%------------------------------------------------------------------- +-module(basic_bugs_beam). + +-export([test/0]). + +%% the following is needed for the test_weird_message +-export([loop/1]). +%% the following are needed for the test_catch_bug +-behaviour(gen_server). +-export([start_link/1]). +-export([init/1, handle_call/3, handle_cast/2, handle_info/2, + terminate/2, code_change/3]). + +test() -> + ok = test_fp_basic_blocks(), + ok = test_weird_message(), + ok = test_catch_bug(), + ok. + +%%-------------------------------------------------------------------- +%% Test which shows that BEAM's splitting of basic blocks should take +%% into account that arithmetic operations implemented as BIFs can +%% also cause exceptions and thus calls to BIFs should end basic blocks. +%% +%% Investigated and fixed in the beginning of April 2004. +%%-------------------------------------------------------------------- + +test_fp_basic_blocks() -> + ok = t1(), + ok = t2(). + +t1() -> + X = (catch bad_arith1(2.0, 1.7)), + case X of + {'EXIT', {badarith, _}} -> + ok; + _ -> + error + end. + +bad_arith1(X, Y) when is_float(X) -> + X1 = X * 1.7e+308, + X2 = X1 + 1.0, + Y1 = Y * 2, + {X2, Y1}. + +%% Similarly, it is not kosher to have anything that can fail inside +%% the fp block since it will throw the exception before the fp +%% exception and we will get the same problems. + +t2() -> + case catch bad_arith2(2.0, []) of + {'EXIT', {badarith, _}} -> + ok; + _ -> + error + end. + +bad_arith2(X, Y) when is_float(X) -> + X1 = X * 1.7e+308, + Y1 = element(1, Y), + {X1 + 1.0, Y1}. + +%%-------------------------------------------------------------------- +%% Sending 'test' to this process should return 'ok'. But: +%% +%% 1> MOD:test(). +%% Weird: received true +%% timeout +%% +%% Surprisingly, the message has been bound to the value of 'ena' +%% in the record! The problem was visible in the .S file. +%%-------------------------------------------------------------------- + +-record(state, {ena = true}). + +test_weird_message() -> + P = spawn_link(?MODULE, loop, [#state{}]), + P ! {msg, self()}, + receive + What -> What + after 42 -> timeout + end. + +loop(S) -> + receive + _ when S#state.ena == false -> + io:format("Weird: ena is false\n"); + % loop(S); + {msg, Pid} -> + Pid ! ok; + % loop(S); + Other -> + io:format("Weird: received ~p\n", [Other]) + % loop(S) + end. + +%%-------------------------------------------------------------------- +%% This was posted on the Erlang mailing list as a question: +%% +%% Given the module below and the function call +%% "catch_bug:start_link(foo)." +%% from the Erlang shell, why does Erlang crash with "Catch not found"? +%% +%% The BEAM compiler was generating wrong code for this case; +%% this was fixed in R9C-0. Native code generation was OK. +%%-------------------------------------------------------------------- + +test_catch_bug() -> + ignore = start_link(foo), + ok. + +start_link(Param) -> + gen_server:start_link(?MODULE, Param, []). + +init(Param) -> + process_flag(trap_exit, true), + (catch begin + dummy(Param), + (catch exit(bar)) + end + ), + ignore. + +dummy(_) -> ok. + +%% gen_server callbacks below +handle_call(_Call, _From, State) -> {noreply, State}. +handle_cast(_Msg, State) -> {noreply, State}. +handle_info(_Msg, State) -> {noreply, State}. +terminate(_Reason, _State) -> ok. +code_change(_OldVsn, State, _Extra) -> {ok, State}. + diff --git a/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl b/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl new file mode 100644 index 0000000000..caa0e71d0b --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_bugs_hipe.erl @@ -0,0 +1,463 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%---------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains code examples that exhibited bugs in the HiPE compiler. +%%%---------------------------------------------------------------------- +-module(basic_bugs_hipe). + +-export([test/0]). + +test() -> + ok = test_ets_bifs(), + ok = test_szar_bug(), + ok = test_bit_shift(), + ok = test_match_big_list(), + ok = test_unsafe_bsl(), + ok = test_unsafe_bsr(), + ok = test_R12B5_seg_fault(), + ok = test_switch_neg_int(), + ok = test_icode_range_anal(), + ok. + +%%----------------------------------------------------------------------- +%% From: Bjorn Gustavsson +%% +%% This code, if HiPE compiled, crashed like this (on SPARC) +%% +%% (gdb) where +%% #0 fullsweep_heap (p=0x2c60dc, new_sz=610, objv=0xffbee8b4, nobj=3) +%% at beam/ggc.c:1060 +%% #1 0x7ff24 in erts_garbage_collect (p=0x2c60dc, need=2, objv=0x1128fc, ...) +%% at beam/ggc.c:1648 +%% #2 0xab6fc in hipe_mode_switch (p=0x2c60dc, cmd=704512, reg=0x1128fc) +%% at hipe/hipe_mode_switch.c:180 +%% #3 0x8e27c in process_main () at beam/beam_emu.c:3314 +%% #4 0x31338 in erl_start (argc=9, argv=0xffbeed5c) at beam/erl_init.c:936 +%% #5 0x2d9f4 in main (argc=9, argv=0xffbeed5c) at sys/unix/erl_main.c:28 +%% +%% A guess at what could be the problem: From R8, many ets BIFs trap +%% to other ets BIFs with a *different* arity (i.e. they have more or +%% less arguments). I have probably forgotten to mention that subtle +%% change. +%%----------------------------------------------------------------------- + +test_ets_bifs() -> + Seed = {1032, 15890, 22716}, + put(random_seed, Seed), + do_random_test(). + +do_random_test() -> + OrdSet = ets:new(xxx, [ordered_set]), + Set = ets:new(xxx, []), + do_n_times(fun() -> + Key = create_random_string(25), + Value = create_random_tuple(25), + ets:insert(OrdSet, {Key, Value}), + ets:insert(Set, {Key, Value}) + end, 5000), + %% io:format("~nData inserted~n"), + do_n_times(fun() -> + I = random:uniform(25), + Key = create_random_string(I) ++ '_', + L1 = ets_match_object(OrdSet, {Key, '_'}), + L2 = lists:sort(ets_match_object(Set, {Key, '_'})), + case L1 == L2 of + false -> + %% io:format("~p != ~p~n", [L1, L2]), + exit({not_eq, L1, L2}); + true -> + ok + end + end, 2000), + %% io:format("~nData matched~n"), + ets:match_delete(OrdSet, '_'), + ets:match_delete(Set, '_'), + ok. + +create_random_string(0) -> + []; +create_random_string(OfLength) -> + C = case random:uniform(2) of + 1 -> (random:uniform($Z - $A + 1) - 1) + $A; + _ -> (random:uniform($z - $a + 1) - 1) + $a + end, + [C | create_random_string(OfLength - 1)]. + +create_random_tuple(OfLength) -> + list_to_tuple([list_to_atom([X]) || X <- create_random_string(OfLength)]). + +ets_match_object(Tab,Expr) -> + case random:uniform(2) of + 1 -> ets:match_object(Tab,Expr); + _ -> match_object_chunked(Tab,Expr) + end. + +match_object_chunked(Tab,Expr) -> + match_object_chunked_collect(ets:match_object(Tab, Expr, + random:uniform(1999) + 1)). + +match_object_chunked_collect('$end_of_table') -> + []; +match_object_chunked_collect({Results, Continuation}) -> + Results ++ match_object_chunked_collect(ets:match_object(Continuation)). + +do_n_times(_, 0) -> + ok; +do_n_times(Fun, N) -> + Fun(), + case N rem 1000 of + 0 -> ok; %% WAS: io:format("."); + _ -> ok + end, + do_n_times(Fun, N - 1). + +%%----------------------------------------------------------------------- +%% From: Jozsef Berces (PR/ECZ) +%% Date: Feb 19, 2004 +%% +%% Program which was added to the testsuite as a result of another bug +%% report involving tuples as funs. Thanks God, these are no longer +%% supported, but the following is a good test for testing calling +%% native code funs from BEAM code (lists:map, lists:filter, ...). +%%----------------------------------------------------------------------- + +test_szar_bug() -> + ["A","B","C"] = smartconcat([], "H'A, H'B, H'C"), + ok. + +smartconcat(B, L) -> + LL = tokenize(L, $,), + NewlineDel = fun (X) -> killcontrol(X) end, + StripFun = fun (X) -> string:strip(X) end, + LL2 = lists:map(NewlineDel, lists:map(StripFun, LL)), + EmptyDel = fun(X) -> + case string:len(X) of + 0 -> false; + _ -> true + end + end, + LL3 = lists:filter(EmptyDel, LL2), + HexFormat = fun(X, Acc) -> + case string:str(X, "H'") of + 1 -> + case checkhex(string:substr(X, 3)) of + {ok, Y} -> + {Y, Acc}; + _ -> + {X, Acc + 1} + end; + _ -> + {X, Acc + 1} + end + end, + {LL4,_Ret} = lists:mapfoldl(HexFormat, 0, LL3), + lists:append(B, lists:sublist(LL4, lists:max([0, 25 - length(B)]))). + +checkhex(L) -> + checkhex(L, ""). + +checkhex([H | T], N) when H >= $0, H =< $9 -> + checkhex(T, [H | N]); +checkhex([H | T], N) when H >= $A, H =< $F -> + checkhex(T, [H | N]); +checkhex([H | T], N) when H =< 32 -> + checkhex(T, N); +checkhex([_ | _], _) -> + {error, ""}; +checkhex([], N) -> + {ok, lists:reverse(N)}. + +killcontrol([C | S]) when C < 32 -> + killcontrol(S); +killcontrol([C | S]) -> + [C | killcontrol(S)]; +killcontrol([]) -> + []. + +tokenize(L, C) -> + tokenize(L, C, [], []). + +tokenize([C | T], C, A, B) -> + case A of + [] -> + tokenize(T, C, [], B); + _ -> + tokenize(T, C, [], [lists:reverse(A) | B]) + end; +tokenize([H | T], C, A, B) -> + tokenize(T, C, [H | A], B); +tokenize(_, _, [], B) -> + lists:reverse(B); +tokenize(_, _, A, B) -> + lists:reverse([lists:reverse(A) | B]). + +%%----------------------------------------------------------------------- +%% From: Niclas Pehrsson +%% Date: Apr 20, 2006 +%% +%% We found something weird with the bit shifting in HiPE. It seems +%% that bsr in some cases shifts the bits in the wrong way... +%% +%% Fixed about 10 mins afterwards; was a bug in constant propagation. +%%----------------------------------------------------------------------- + +test_bit_shift() -> + 1 = plain_shift(), % 1 + 6 = length_list_plus(), % 6 + 0 = shift_length_list(), % 0 + 1 = shift_length_list_plus(), % 1 + 1 = shift_length_list_plus2(), % 1 + 24 = shift_length_list_plus_bsl(), % 24 + 1 = shift_fun(), % 1 + %% {1, 6, 0, 1, 1, 24, 1} = {A, B, C, D, E, F, G}, + ok. + +plain_shift() -> + 6 bsr 2. + +length_list() -> + length([0,0]). + +length_list_plus() -> + length([0,0]) + 4. + +shift_length_list() -> + length([0,0]) bsr 2. + +shift_length_list_plus() -> + (length([0,0]) + 4) bsr 2. + +shift_length_list_plus_bsl() -> + (length([0,0]) + 4) bsl 2. + +shift_length_list_plus2() -> + N = length([0,0]) + 4, + N bsr 2. + +shift_fun() -> + (length_list() + 4) bsr 2. + +%%----------------------------------------------------------------------- +%% From: Igor Goryachev +%% Date: June 15, 2006 +%% +%% I have experienced a different behaviour and possibly a weird result +%% while playing with matching a big list on x86 and x86_64 machines. +%%----------------------------------------------------------------------- + +-define(BIG_LIST, + ["uid", "nickname", "n_family", "n_given", "email_pref", + "tel_home_number", "tel_cellular_number", "adr_home_country", + "adr_home_locality", "adr_home_region", "url", "gender", "bday", + "constitution", "height", "weight", "hair", "routine", "smoke", + "maritalstatus", "children", "independence", "school_number", + "school_locality", "school_title", "school_period", "org_orgname", + "title", "adr_work_locality", "photo_type", "photo_binval"]). + +test_match_big_list() -> + case create_tuple_with_big_const_list() of + {selected, ?BIG_LIST, _} -> ok; + _ -> weird + end. + +create_tuple_with_big_const_list() -> + {selected, ?BIG_LIST, [{"test"}]}. + +%%----------------------------------------------------------------------- +%% In October 2006 the HiPE compiler acquired more type-driven +%% optimisations of arithmetic operations. One of these, the +%% transformation of bsl to a pure fixnum bsl fixnum -> fixnum version +%% (unsafe_bsl), was incorrectly performed even when the result +%% wouldn't be a fixnum. The error occurred for all backends, but the +%% only place known to break was hipe_arm:imm_to_am1/2. Some +%% immediates got broken on ARM, causing segmentation faults in +%% compiler_tests when HiPE recompiled itself. +%%----------------------------------------------------------------------- + +test_unsafe_bsl() -> + ok = bsl_check(bsl_test_cases()). + +bsl_test_cases() -> + [{16#FF, {16#FF, 0}}, + {16#F000000F, {16#FF, 2}}]. + +bsl_check([]) -> ok; +bsl_check([{X, Y}|Rest]) -> + case imm_to_am1(X) of + Y -> bsl_check(Rest); + _ -> 'hipe_broke_bsl' + end. + +imm_to_am1(Imm) -> + imm_to_am1(Imm band 16#FFFFFFFF, 16). +imm_to_am1(Imm, RotCnt) -> + if Imm >= 0, Imm =< 255 -> {Imm, RotCnt band 15}; + true -> + NewRotCnt = RotCnt - 1, + if NewRotCnt =:= 0 -> []; % full circle, no joy + true -> + NewImm = (Imm bsr 2) bor ((Imm band 3) bsl 30), + imm_to_am1(NewImm, NewRotCnt) + end + end. + +%%----------------------------------------------------------------------- +%% Another transformation, namely that of bsr to a pure fixnum bsr +%% fixnum -> fixnum version (unsafe_bsr), failed to check for shifts +%% larger than the number of bits in fixnums. Such shifts should +%% return zero, but instead they became plain machine-level shift +%% instructions. Machines often only consider the low-order bits of +%% the shift count, so machine-level shifts larger than the word size +%% do not match the Erlang semantics. +%%----------------------------------------------------------------------- + +test_unsafe_bsr() -> + ok = bsr_check(bsr_test_cases()). + +bsr_test_cases() -> + [{16#FF, 4, 16#0F}, + {16#FF, 64, 0}]. + +bsr_check([]) -> ok; +bsr_check([{X, Y, Z}|Rest]) -> + case do_bsr(X, Y) of + Z -> bsr_check(Rest); + _ -> 'hipe_broke_bsr' + end. + +do_bsr(X, Y) -> + (X band 16#FFFF) bsr (Y band 16#FFFF). + +%%----------------------------------------------------------------------- +%% From: Sergey S, mid January 2009. +%% +%% While I was playing with +native option, I run into a bug in HiPE +%% which leads to segmentation fault using +native and Erlang R12B-5. +%% +%% Eshell V5.6.5 +%% 1> crash:test(). +%% # Some message to be printed here each loop iteration +%% Segmentation fault +%% +%% Diagnosed and fixed by Mikael Pettersson (22 Jan 2009): +%% +%% I've analysed the recently posted HiPE bug report on erlang-bugs +%% <http://www.erlang.org/pipermail/erlang-bugs/2009-January/001162.html>. +%% The segfault is caused by memory corruption, which in turn is caused +%% by RTL removing an update of the HP (heap pointer) register due to +%% what looks like broken liveness information. +%%----------------------------------------------------------------------- + +test_R12B5_seg_fault() -> + _ = spawn(fun() -> init() end), + ok. + +init() -> + repeat(5, fun() -> void end), + receive after infinity -> ok end. + +repeat(0, _) -> + ok; +repeat(N, Fun) -> + %% io:format("# Some message to be printed here each loop iteration\n"), + Fun(), + repeat(N - 1, Fun). + +%%----------------------------------------------------------------------- +%% From: Jon Meredith +%% Date: July 9, 2009 +%% +%% Binary search key tables are sorted by the loader based on the +%% runtime representations of the keys as unsigned words. However, +%% the code generated for the binary search used signed comparisons. +%% That worked for atoms and non-negative fixnums, but not for +%% negative fixnums. Fixed by Mikael Pettersson July 10, 2009. +%%----------------------------------------------------------------------- + +test_switch_neg_int() -> + ok = f(-80, 8). + +f(10, -1) -> ok; +f(X, Y) -> + Y = g(X), + f(X + 10, Y - 1). + +g(X) -> % g(0) should be 0 but became -1 + case X of + 0 -> 0; + -10 -> 1; + -20 -> 2; + -30 -> 3; + -40 -> 4; + -50 -> 5; + -60 -> 6; + -70 -> 7; + -80 -> 8; + _ -> -1 + end. + +%%----------------------------------------------------------------------- +%% From: Paul Guyot +%% Date: Jan 31, 2011 +%% +%% There is a bug in HiPE compilation with the comparison of floats +%% with integers. This bug happens in functions f/1 and g/2 below. +%% BEAM will evaluate f_eq(42) and f_eq(42.0) to true, while HiPE +%% will evaluate them to false. +%% +%% The culprit was the Icode range analysis which was buggy. (On the +%% other hand, HiPE properly evaluated these calls to true if passed +%% the option 'no_icode_range'.) Fixed by Kostis Sagonas. +%% -------------------------------------------------------------------- + +test_icode_range_anal() -> + true = f_eq(42), + true = f_eq(42.0), + false = f_ne(42), + false = f_ne(42.0), + false = f_eq_ex(42), + false = f_eq_ex(42.0), + true = f_ne_ex(42), + true = f_ne_ex(42.0), + false = f_gt(42), + false = f_gt(42.0), + true = f_le(42), + true = f_le(42.0), + zero_test = g(0, test), + zero_test = g(0.0, test), + non_zero_test = g(42, test), + other = g(42, other), + ok. + +f_eq(X) -> + Y = X / 2, + Y == 21. + +f_ne(X) -> + Y = X / 2, + Y /= 21. + +f_eq_ex(X) -> + Y = X / 2, + Y =:= 21. + +f_ne_ex(X) -> + Y = X / 2, + Y =/= 21. + +f_gt(X) -> + Y = X / 2, + Y > 21. + +f_le(X) -> + Y = X / 2, + Y =< 21. + +g(X, Z) -> + Y = X / 2, + case Z of + test when Y == 0 -> zero_test; + test -> non_zero_test; + other -> other + end. diff --git a/lib/hipe/test/basic_SUITE_data/basic_comparisons.erl b/lib/hipe/test/basic_SUITE_data/basic_comparisons.erl new file mode 100644 index 0000000000..8dab2cab1f --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_comparisons.erl @@ -0,0 +1,157 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests for correct execution of comparison operators. +%%%------------------------------------------------------------------- +-module(basic_comparisons). + +-export([test/0]). + +test() -> + Ns = [0, 0.0, 42, 42.0, gazonk], + T1F4 = [true, false, false, false, false], + T2F3 = [true, true, false, false, false], + F1T4 = [false, true, true, true, true], + F2T3 = [false, false, true, true, true], + %% tests for calls + T1F4 = [eq_exact_call(0, N) || N <- Ns], + F1T4 = [ne_exact_call(0, N) || N <- Ns], + T2F3 = [eq_call(0, N) || N <- Ns], + F2T3 = [ne_call(0, N) || N <- Ns], + %% tests for guards + T1F4 = [eq_exact_guard(0, N) || N <- Ns], + F1T4 = [ne_exact_guard(0, N) || N <- Ns], + T2F3 = [eq_guard(0, N) || N <- Ns], + F2T3 = [ne_guard(0, N) || N <- Ns], + %% some more tests + ok = test_against_zero(), + ok = test_against_other_terms(), + ok = test_sofs_func(), + ok. + +test_against_zero() -> + Xs = [0, 1, 0.0], + [true, false, false] = [is_zero_int(X) || X <- Xs], + [true, false, true] = [is_zero_num(X) || X <- Xs], + [false, true, true] = [is_nonzero_int(X) || X <- Xs], + [false, true, false] = [is_nonzero_num(X) || X <- Xs], + ok. + +test_against_other_terms() -> + TTT = {true, true, true}, + FFF = {false, false, false}, + TTT = {is_foo_exact(foo), is_foo_term1(foo), is_foo_term2(foo)}, + FFF = {is_foo_exact(bar), is_foo_term1(bar), is_foo_term2(bar)}, + FFF = {is_nonfoo_exact(foo), is_nonfoo_term1(foo), is_nonfoo_term2(foo)}, + TTT = {is_nonfoo_exact(bar), is_nonfoo_term1(bar), is_nonfoo_term2(bar)}, + Tup = {a, {42}, [c]}, + TTT = {is_tuple_skel(Tup), is_tuple_exact(Tup), is_tuple_term(Tup)}, + BNi = <<42>>, + TTT = {is_bin_exact(BNi), is_bin_term1(BNi), is_bin_term2(BNi)}, + BNf = <<42/float>>, + FFF = {is_bin_exact(BNf), is_bin_term1(BNf), is_bin_term2(BNf)}, + ok. + +test_sofs_func() -> + L = [0, 0.0], + ok = sofs_func(L, L, L). + +%%-------------------------------------------------------------------- +%% Test for comparison operators used in body calls + +eq_exact_call(X, Y) -> X =:= Y. + +ne_exact_call(X, Y) -> X =/= Y. + +eq_call(X, Y) -> X == Y. + +ne_call(X, Y) -> X /= Y. + +%%-------------------------------------------------------------------- +%% Tests for comparison operators used as guards + +eq_exact_guard(X, Y) when X =:= Y -> true; +eq_exact_guard(_, _) -> false. + +ne_exact_guard(X, Y) when X =/= Y -> true; +ne_exact_guard(_, _) -> false. + +eq_guard(X, Y) when X == Y -> true; +eq_guard(_, _) -> false. + +ne_guard(X, Y) when X /= Y -> true; +ne_guard(_, _) -> false. + +%%-------------------------------------------------------------------- + +is_zero_int(N) when N =:= 0 -> true; +is_zero_int(_) -> false. + +is_nonzero_int(N) when N =/= 0 -> true; +is_nonzero_int(_) -> false. + +is_zero_num(N) when N == 0 -> true; +is_zero_num(_) -> false. + +is_nonzero_num(N) when N /= 0 -> true; +is_nonzero_num(_) -> false. + +%%-------------------------------------------------------------------- +%% There should not really be any difference in the generated code +%% for the following three functions. + +is_foo_exact(A) when A =:= foo -> true; +is_foo_exact(_) -> false. + +is_foo_term1(A) when A == foo -> true; +is_foo_term1(_) -> false. + +is_foo_term2(A) when foo == A -> true; +is_foo_term2(_) -> false. + +%%-------------------------------------------------------------------- +%% Same for these cases + +is_nonfoo_exact(A) when A =/= foo -> true; +is_nonfoo_exact(_) -> false. + +is_nonfoo_term1(A) when A /= foo -> true; +is_nonfoo_term1(_) -> false. + +is_nonfoo_term2(A) when foo /= A -> true; +is_nonfoo_term2(_) -> false. + +%%-------------------------------------------------------------------- + +is_tuple_skel({A,{B},[C]}) when is_atom(A), is_integer(B), is_atom(C) -> true; +is_tuple_skel(T) when is_tuple(T) -> false. + +is_tuple_exact(T) when T =:= {a,{42},[c]} -> true; +is_tuple_exact(T) when is_tuple(T) -> false. + +is_tuple_term(T) when T == {a,{42.0},[c]} -> true; +is_tuple_term(T) when is_tuple(T) -> false. + +%%-------------------------------------------------------------------- +%% But for binaries the treatment has to be different, due to the need +%% for construction of the binary in the guard. + +is_bin_exact(B) when B =:= <<42>> -> true; +is_bin_exact(_) -> false. + +is_bin_term1(B) when B == <<42>> -> true; +is_bin_term1(_) -> false. + +is_bin_term2(B) when <<42>> == B -> true; +is_bin_term2(_) -> false. + +%%-------------------------------------------------------------------- +%% a test from sofs.erl which failed at some point + +sofs_func([X | Ts], X0, L) when X /= X0 -> + sofs_func(Ts, X, L); +sofs_func([X | _Ts], X0, _L) when X == X0 -> + ok; +sofs_func([], _X0, L) -> + L. diff --git a/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl b/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl new file mode 100644 index 0000000000..229a0516dc --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_exceptions.erl @@ -0,0 +1,465 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests that raise exceptions and catch them. +%%%------------------------------------------------------------------- +-module(basic_exceptions). + +-export([test/0, test_catches/0]). + +%% functions used as arguments to spawn/3 +-export([bad_guy/2]). + +test() -> + ok = test_catch_exit(42), + ok = test_catch_throw(42), + ok = test_catch_element(), + ok = test_catch_crash(), + ok = test_catch_empty(), + ok = test_catch_merge(), + ok = test_catches_merged(), + ok = test_pending_errors(), + ok = test_bad_fun_call(), + ok = test_guard_bif(), + ok. + +%%-------------------------------------------------------------------- +%% Written in 2001 by Erik Johansson. + +test_catches() -> + ExitBar = {'EXIT', bar}, + L1 = [ExitBar, ok, ExitBar, {ok, ExitBar}], + L1 = [t1(), t2(), t3(), t4()], + badarith = (catch element(1, element(2, t5(a, b)))), + L2 = [42, ExitBar, ExitBar, {no_exception, ok}], + L2 = [t5(21, 21), t6(), t7(), t8()], + ok. + +t1() -> + catch foo(). + +t2() -> + V = (catch ok()), + s(), + V. + +t3() -> + V = (catch foo()), + V. + +t4() -> + V1 = ok(), + V2 = (catch foo()), + {V1, V2}. + +t5(A, B) -> + catch A + B. + +t6() -> + catch {no_exception, ok(), foo()}. + +t7() -> + catch {no_exception, foo(), ok()}. + +t8() -> + catch {no_exception, ok()}. + +foo() -> + s(), + exit(bar). + +ok() -> s(), ok. + +s() -> nada. + +%%-------------------------------------------------------------------- + +test_catch_exit(N) -> + {'EXIT', N} = (catch exit(N)), + {'EXIT', 42} = (catch exit(42)), + 42 = try exit(N) catch exit:R1 -> R1 end, + 42 = try exit(42) catch exit:R2 -> R2 end, + ok. + +%%-------------------------------------------------------------------- + +test_catch_throw(N) -> + N = (catch throw(N)), + 42 = (catch throw(42)), + 42 = try throw(N) catch throw:R1 -> R1 end, + 42 = try throw(42) catch throw:R2 -> R2 end, + ok. + +%%-------------------------------------------------------------------- + +test_catch_element() -> + 'EXIT' = test_catch_element([]), + 'EXIT' = test_catch_element(42), + ok. + +test_catch_element(N) -> + element(1, catch element(N, {1,2,3,4,5,6,7,8,9,10,11})). + +%%-------------------------------------------------------------------- + +-define(try_match(E), + catch ?MODULE:non_existing(), + {'EXIT', {{badmatch, nomatch}, _}} = (catch E = no_match())). + +test_catch_crash() -> + ?try_match(a), + ?try_match(42), + ?try_match({a, b, c}), + ?try_match([]), + ?try_match(1.0), + ok. + +no_match() -> nomatch. + +%% small_test() -> +%% catch ?MODULE:non_existing(), +%% io:format("Before\n",[]), +%% hipe_bifs:show_nstack(self()), +%% io:format("After\n",[]), +%% garbage_collect(). + +%%-------------------------------------------------------------------- +%% Tests whether the HiPE compiler optimizes catches in a way that +%% does not result in an infinite loop. +%%-------------------------------------------------------------------- + +test_catch_empty() -> + badmatch(). + +badmatch() -> + Big = ret_big(), + Float = ret_float(), + catch a = Big, + catch b = Float, + ok = case Big of Big -> ok end, + ok = case Float of Float -> ok end, + ok. + +ret_big() -> + 329847987298478924982978248748729829487298292982972978239874. + +ret_float() -> + 3.1415927. + +%%-------------------------------------------------------------------- +%% Test that shows how BEAM can merge catch-end blocks that belong to +%% different catch-start instructions. Written by Richard Carlsson. +%%-------------------------------------------------------------------- + +test_catch_merge() -> + merge(get(whatever)). + +merge(foo=X) -> + catch f(X), + catch g(X); +merge(X) -> + catch f(X), + catch g(X). + +f(_) -> ok. + +g(_) -> ok. + +%%-------------------------------------------------------------------- +%% Written by Tobias Lindahl. + +test_catches_merged() -> + {'EXIT', _} = merged_catches(foo), + {'EXIT', {badarith, _}} = merged_catches(bar), + {'EXIT', _} = merged_catches(baz), + ok. + +merged_catches(X) -> + case X of + foo -> catch fail1(0); + bar -> catch {catch(1 = X), fail2(0)}; + baz -> catch fail3(0) + end. + +fail1(X) -> 1/X. + +fail2(X) -> 1/X. + +fail3(X) -> 1/X. + +%%-------------------------------------------------------------------- +%% Taken from exception_SUITE.erl +%%-------------------------------------------------------------------- + +test_pending_errors() -> + error_logger:tty(false), % disable printouts of error reports + pending_errors(). + +%% Test various exceptions, in the presence of a previous error +%% suppressed in a guard. +pending_errors() -> + pending(e_badmatch, {badmatch, b}), + pending(x, function_clause), + pending(e_case, {case_clause, xxx}), + pending(e_if, if_clause), + %% pending(e_badarith, badarith), + %% pending(e_undef, undef), + pending(e_timeoutval, timeout_value), + %% pending(e_badarg, badarg), + %% pending(e_badarg_spawn, badarg), + ok. + +bad_guy(pe_badarith, Other) when Other+1 =:= 0 -> % badarith (suppressed) + ok; +bad_guy(pe_badarg, Other) when length(Other) > 0 -> % badarg (suppressed) + ok; +bad_guy(_, e_case) -> + case xxx() of + ok -> ok + end; % case_clause +bad_guy(_, e_if) -> + B = b(), + if + a == B -> ok + end; % if_clause +%% bad_guy(_, e_badarith) -> +%% 1+b; % badarith +bad_guy(_, e_undef) -> + non_existing_module:foo(); % undef +bad_guy(_, e_timeoutval) -> + receive + after gazonk -> ok % timeout_value + end; +bad_guy(_, e_badarg) -> + node(xxx); % badarg +bad_guy(_, e_badarg_spawn) -> + spawn({}, {}, {}); % badarg +bad_guy(_, e_badmatch) -> + a = b(). % badmatch + +xxx() -> xxx. + +b() -> b. + +pending(Arg, Expected) -> + pending(pe_badarith, Arg, Expected), + pending(pe_badarg, Arg, Expected). + +pending(First, Second, Expected) -> + pending_catched(First, Second, Expected), + pending_exit_message([First, Second], Expected). + +pending_catched(First, Second, Expected) -> + %% ok = io:format("Catching bad_guy(~p, ~p)\n", [First, Second]), + case catch bad_guy(First, Second) of + {'EXIT', Reason} -> + pending(Reason, bad_guy, [First, Second], Expected); + Other -> + exit({not_exit, Other}) + end. + +pending_exit_message(Args, Expected) -> + %% ok = io:format("Trapping exits from spawn_link(~p, ~p, ~p)\n", + %% [?MODULE, bad_guy, Args]), + process_flag(trap_exit, true), + Pid = spawn_link(?MODULE, bad_guy, Args), + receive + {'EXIT', Pid, Reason} -> + pending(Reason, bad_guy, Args, Expected); + Other -> + exit({unexpected_message, Other}) + after 10000 -> + exit(timeout) + end, + process_flag(trap_exit, false). + +%% pending({badarg, [{erlang,Bif,BifArgs},{?MODULE,Func,Arity}|_]}, +%% Func, Args, _Code) +%% when atom(Bif), list(BifArgs), length(Args) =:= Arity -> +%% ok; +pending({badarg,Trace}, _, _, _) when is_list(Trace) -> + ok; +%% pending({undef,[{non_existing_module,foo,[]}|_]}, _, _, _) -> +%% ok; +pending({undef,Trace}, _, _, _) when is_list(Trace) -> + ok; +%% pending({function_clause,[{?MODULE,Func,Args}|_]}, Func, Args, _Code) -> +%% ok; +pending({function_clause,Trace}, _, _, _) when is_list(Trace) -> + ok; +%% pending({Code,[{?MODULE,Func,Arity}|_]}, Func, Args, Code) +%% when length(Args) =:= Arity -> +%% ok; +pending({Code,Trace}, _, _, Code) when is_list(Trace) -> + ok; +pending(Reason, _Function, _Args, _Code) -> + exit({bad_exit_reason, Reason}). + +%%-------------------------------------------------------------------- +%% Taken from fun_SUITE.erl +%% +%% Checks correct exception throwing when calling a bad fun. +%%-------------------------------------------------------------------- + +test_bad_fun_call() -> + ok = bad_call_fc(42), + ok = bad_call_fc(xx), + ok = bad_call_fc({}), + ok = bad_call_fc({1}), + ok = bad_call_fc({1,2,3}), + ok = bad_call_fc({1,2,3}), + ok = bad_call_fc({1,2,3,4}), + ok = bad_call_fc({1,2,3,4,5,6}), + ok = bad_call_fc({1,2,3,4,5}), + ok = bad_call_fc({1,2}), + ok. + +bad_call_fc(Fun) -> + Args = [some, stupid, args], + Res = (catch Fun(Fun(Args))), + case Res of + {'EXIT', {{badfun, Fun} ,_Where}} -> + ok; %% = io:format("~p(~p) -> ~p\n", [Fun, Args, Res]); + Other -> + io:format("~p(~p) -> ~p\n", [Fun, Args, Res]), + exit({bad_result, Other}) + end. + +%%-------------------------------------------------------------------- +%% Taken from guard_SUITE.erl +%% +%% Tests correct handling of exceptions by calling guard BIFs with +%% nasty (but legal arguments). +%%-------------------------------------------------------------------- + +test_guard_bif() -> + Big = -237849247829874297658726487367328971246284736473821617265433, + Float = 387924.874, + + %% Succeding use of guard bifs. + + try_gbif('abs/1', Big, -Big), + try_gbif('float/1', Big, float(Big)), + try_gbif('trunc/1', Float, 387924.0), + try_gbif('round/1', Float, 387925.0), + try_gbif('length/1', [], 0), + + try_gbif('length/1', [a], 1), + try_gbif('length/1', [a, b], 2), + try_gbif('length/1', lists:seq(0, 31), 32), + + try_gbif('hd/1', [a], a), + try_gbif('hd/1', [a, b], a), + + try_gbif('tl/1', [a], []), + try_gbif('tl/1', [a, b], [b]), + try_gbif('tl/1', [a, b, c], [b, c]), + + try_gbif('size/1', {}, 0), + try_gbif('size/1', {a}, 1), + try_gbif('size/1', {a, b}, 2), + try_gbif('size/1', {a, b, c}, 3), + try_gbif('size/1', list_to_binary([]), 0), + try_gbif('size/1', list_to_binary([1]), 1), + try_gbif('size/1', list_to_binary([1, 2]), 2), + try_gbif('size/1', list_to_binary([1, 2, 3]), 3), + + try_gbif('element/2', {x}, {1, x}), + try_gbif('element/2', {x, y}, {1, x}), + try_gbif('element/2', {x, y}, {2, y}), + + try_gbif('self/0', 0, self()), + try_gbif('node/0', 0, node()), + try_gbif('node/1', self(), node()), + + %% Failing use of guard bifs. + + try_fail_gbif('abs/1', Big, 1), + try_fail_gbif('abs/1', [], 1), + + try_fail_gbif('float/1', Big, 42), + try_fail_gbif('float/1', [], 42), + + try_fail_gbif('trunc/1', Float, 0.0), + try_fail_gbif('trunc/1', [], 0.0), + + try_fail_gbif('round/1', Float, 1.0), + try_fail_gbif('round/1', [], a), + + try_fail_gbif('length/1', [], 1), + try_fail_gbif('length/1', [a], 0), + try_fail_gbif('length/1', a, 0), + try_fail_gbif('length/1', {a}, 0), + + try_fail_gbif('hd/1', [], 0), + try_fail_gbif('hd/1', [a], x), + try_fail_gbif('hd/1', x, x), + + try_fail_gbif('tl/1', [], 0), + try_fail_gbif('tl/1', [a], x), + try_fail_gbif('tl/1', x, x), + + try_fail_gbif('size/1', {}, 1), + try_fail_gbif('size/1', [], 0), + try_fail_gbif('size/1', [a], 1), + try_fail_gbif('size/1', fun() -> 1 end, 0), + try_fail_gbif('size/1', fun() -> 1 end, 1), + + try_fail_gbif('element/2', {}, {1, x}), + try_fail_gbif('element/2', {x}, {1, y}), + try_fail_gbif('element/2', [], {1, z}), + + try_fail_gbif('self/0', 0, list_to_pid("<0.0.0>")), + try_fail_gbif('node/0', 0, xxxx), + try_fail_gbif('node/1', self(), xxx), + try_fail_gbif('node/1', yyy, xxx), + ok. + +try_gbif(Id, X, Y) -> + case guard_bif(Id, X, Y) of + {Id, X, Y} -> + %% io:format("guard_bif(~p, ~p, ~p) -- ok\n", [Id, X, Y]); + ok; + Other -> + ok = io:format("guard_bif(~p, ~p, ~p) -- bad result: ~p\n", + [Id, X, Y, Other]), + exit({bad_result,try_gbif}) + end. + +try_fail_gbif(Id, X, Y) -> + case catch guard_bif(Id, X, Y) of + %% {'EXIT', {function_clause,[{?MODULE,guard_bif,[Id,X,Y]}|_]}} -> + {'EXIT', {function_clause,_}} -> % in HiPE, a trace is not generated + %% io:format("guard_bif(~p, ~p, ~p) -- ok\n", [Id,X,Y]); + ok; + Other -> + ok = io:format("guard_bif(~p, ~p, ~p) -- bad result: ~p\n", + [Id, X, Y, Other]), + exit({bad_result,try_fail_gbif}) + end. + +guard_bif('abs/1', X, Y) when abs(X) == Y -> + {'abs/1', X, Y}; +guard_bif('float/1', X, Y) when float(X) == Y -> + {'float/1', X, Y}; +guard_bif('trunc/1', X, Y) when trunc(X) == Y -> + {'trunc/1', X, Y}; +guard_bif('round/1', X, Y) when round(X) == Y -> + {'round/1', X, Y}; +guard_bif('length/1', X, Y) when length(X) == Y -> + {'length/1', X, Y}; +guard_bif('hd/1', X, Y) when hd(X) == Y -> + {'hd/1', X, Y}; +guard_bif('tl/1', X, Y) when tl(X) == Y -> + {'tl/1', X, Y}; +guard_bif('size/1', X, Y) when size(X) == Y -> + {'size/1', X, Y}; +guard_bif('element/2', X, {Pos, Expected}) when element(Pos, X) == Expected -> + {'element/2', X, {Pos, Expected}}; +guard_bif('self/0', X, Y) when self() == Y -> + {'self/0', X, Y}; +guard_bif('node/0', X, Y) when node() == Y -> + {'node/0', X, Y}; +guard_bif('node/1', X, Y) when node(X) == Y -> + {'node/1', X, Y}. diff --git a/lib/hipe/test/basic_SUITE_data/basic_floats.erl b/lib/hipe/test/basic_SUITE_data/basic_floats.erl new file mode 100644 index 0000000000..ce28f6e156 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_floats.erl @@ -0,0 +1,250 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests that manipulate floating point numbers. +%%%------------------------------------------------------------------- +-module(basic_floats). + +-export([test/0]). +-export([test_fmt_double_fpe_leak/0]). % suppress the unused warning + +test() -> + ok = test_arith_ops(), + ok = test_fp_ebb(), + ok = test_fp_phi(), + ok = test_big_bad_float(), + ok = test_catch_bad_fp_arith(), + ok = test_catch_fp_conv(), + ok = test_fp_with_fp_exceptions(), + %% ok = test_fmt_double_fpe_leak(), % this requires printing + ok = test_icode_type_crash(), + ok = test_icode_type_crash_2(), + ok. + +%%-------------------------------------------------------------------- + +test_arith_ops() -> + E = 2.5617, + 5.703200000000001 = add(E), + 0.5798000000000001 = sub(E), + 8.047580550000001 = mult(E), + -6.023e23 = negate(6.023e23), + ok. + +add(X) -> + 3.1415 + X. + +sub(X) -> + 3.1415 - X. + +mult(X) -> + 3.1415 * X. + +%% tests the translation of the fnegate BEAM instruction. +negate(X) -> + - (X + 0.0). + +%%-------------------------------------------------------------------- +%% Test the construction of overlapping extended basic blocks where +%% BEAM has constructed one and hipe_icode_fp constructs the other. +%%-------------------------------------------------------------------- + +test_fp_ebb() -> + 1.0 = foo(2 * math:pi()), + 1.0 = bar(2 * math:pi()), + ok. + +foo(X) -> + X / (2 * math:pi()). + +bar(X) -> + F = float_two(), + case F < 3.0 of + true -> (X * F) / ((2 * F) * math:pi()); + false -> weird + end. + +float_two() -> + 2.0. + +%%-------------------------------------------------------------------- + +test_fp_phi() -> + 10 = fp_phi(10, 100), + undefined = fp_phi(1.1e302, 0.000000001), + ok. + +fp_phi(A, B) -> + case catch A / B of + {'EXIT', _Reason} -> undefined; + _ -> round(100 * (A / B)) + end. + +%%-------------------------------------------------------------------- + +-define(BS, "93904329458954829589425849258998492384932849328493284932849328493284932389248329432932483294832949245827588578423578435783475834758375837580745807304258924584295924588459834958349589348589345934859384958349583945893458934859438593485995348594385943859438593458934589345938594385934859483958348934589435894859485943859438594594385938459438595034950439504395043950495043593485943758.0"). + +test_big_bad_float() -> + ok = try f2l(?BS) catch error:badarg -> ok end, + ok = case catch f2l(?BS) of {'EXIT', {badarg, _}} -> ok end, + ok. + +f2l(F) -> + float_to_list(list_to_float(F)). + +%%-------------------------------------------------------------------- +%% Tests catching of floating point bad arithmetic. + +test_catch_bad_fp_arith() -> + 5.7 = f(2.56), + {'EXIT', {badarith, _}} = bad_arith(9.9), + ok. + +f(F) when is_float(F) -> F + 3.14. + +bad_arith(F) when is_float(F) -> + catch F * 1.70000e+308. + +%%-------------------------------------------------------------------- +%% Tests proper catching of exceptions due to illegal convertion of +%% bignums to floating point numbers. + +test_catch_fp_conv() -> + F = 1.7e308, %% F is a number very close to a maximum float. + ok = big_arith(F), + ok = big_const_float(F), + ok. + +big_arith(F) -> + I = trunc(F), + {'EXIT', {badarith, _}} = big_int_arith(I), + ok. + +big_int_arith(I) when is_integer(I) -> + catch(3.0 + 2*I). + +big_const_float(F) -> + I = trunc(F), + badarith = try (1/(2*I)) catch error:Err -> Err end, + _ = 2/I, + {'EXIT', _} = (catch 4/(2*I)), + ok. + +%%-------------------------------------------------------------------- +%% Forces floating point exceptions and tests that subsequent, legal, +%% operations are calculated correctly. + +test_fp_with_fp_exceptions() -> + 0.0 = math:log(1.0), + badarith = try math:log(float_minus_one()) catch error:E1 -> E1 end, + 0.0 = math:log(1.0), + badarith = try math:log(float_zero()) catch error:E2 -> E2 end, + 0.0 = math:log(1.0), + %% An old-fashioned exception here just so as to test this case also + {'EXIT', _} = (catch fp_mult(3.23e133, 3.57e257)), + 0.0 = math:log(1.0), + badarith = try fp_div(5.0, 0.0) catch error:E3 -> E3 end, + 0.0 = math:log(1.0), + ok. + +fp_mult(X, Y) -> X * Y. + +fp_div(X, Y) -> X / Y. + +%% The following two function definitions appear here just to shut +%% off 'expression will fail with a badarg' warnings from the compiler + +float_zero() -> 0.0. + +float_minus_one() -> -1.0. + +%%-------------------------------------------------------------------- +%% Test that erl_printf_format.c:fmt_double() does not leak pending FP +%% exceptions to subsequent code. This used to break x87 FP code on +%% 32-bit x86. Based on a problem report from Richard Carlsson. + +test_fmt_double_fpe_leak() -> + test_fmt_double_fpe_leak(float_zero(), int_two()), + ok. + +%% We need the specific sequence of erlang:display/1 on a float that +%% triggers faulting ops in fmt_double() followed by a simple FP BIF. +%% We also need to repeat this at least three times. +test_fmt_double_fpe_leak(X, Y) -> + erlang:display(X), _ = math:log10(Y), + erlang:display(X), _ = math:log10(Y), + erlang:display(X), _ = math:log10(Y), + erlang:display(X), _ = math:log10(Y), + erlang:display(X), + math:log10(Y). + +int_two() -> 2. + +%%-------------------------------------------------------------------- +%% Contains code which confuses the icode_type analysis and results +%% in a compiler crash. Stipped down from code sent by Paul Guyot. +%% Compiles alright with the option 'no_icode_type' but that defeats +%% the purpose of the test. + +test_icode_type_crash() -> + Fun = f(1, 2, 3), + 42.0 = Fun(), + ok. + +f(A, B, C) -> + fun () -> + X = case A of + 0 -> 1 / B; + _ -> A / C + end, + Y = case B of + a -> 1.0; + b -> 2.0; + _ -> 6.0 + end, + Z = case C of + c -> 0.1 * X; + _ -> 7.0 + end, + Y * Z + end. + +%%-------------------------------------------------------------------- +%% Contains another case that crashed hipe_icode_fp. This sample was +%% sent by Mattias Jansson (25 Nov 2015). It compiled alright with the +%% option 'no_icode_type' but that defeats the purpose of the test. +%% Unfortunately, the execution of this code goes into an infinite +%% loop, even if the map in the second argument of eat_what/2 gets the +%% appropriate key-value pairs. Still, it is retained as a test +%% because it exposed a different crash than test_icode_type_crash/0. + +test_icode_type_crash_2() -> + {'EXIT', {function_clause, _}} = (catch eat()), + ok. + +eat() -> + eat_what(1.0, #{}). + +eat_what(Factor, #{rat_type := LT} = Rat) -> + #{cheese := Cheese} = Rat, + UnitCheese = Cheese / 2, + RetA = case eat() of + {full, RetA1} -> + CheeseB2 = min(RetA1, UnitCheese) * Factor, + case eat() of + full -> {win, RetA1}; + hungry -> {partial, RetA1 - CheeseB2} + end; + AOther -> AOther + end, + RetB = case eat() of + {full, RetB1} -> + CheeseA2 = min(RetB1, UnitCheese) * Factor, + rat:init(single, LT, CheeseA2), + case eat() of + full -> {full, RetB1}; + hungry -> {hungry, RetB1 - CheeseA2} + end + end, + {RetA, RetB}. diff --git a/lib/hipe/test/basic_SUITE_data/basic_fun.erl b/lib/hipe/test/basic_SUITE_data/basic_fun.erl new file mode 100644 index 0000000000..18ba7fdb3f --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_fun.erl @@ -0,0 +1,124 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Tests for correct handling of funs. +%%%------------------------------------------------------------------- +-module(basic_fun). + +-export([test/0]). + +-export([dummy_foo/4, add1/1, test_fun03/0]). + +test() -> + ok = test_calls(), + ok = test_is_function(), + ok = test_is_function2(), + ok. + +%%-------------------------------------------------------------------- +%% Tests function and fun calls. + +test_calls() -> + ok = test_apply_call(?MODULE, dummy_foo), + ok = test_fun_call(fun dummy_foo/4), + ok = test_fun_call(fun ?MODULE:dummy_foo/4), + ok. + +test_apply_call(M, F) -> + M:F(bar, 42, foo, 17). + +test_fun_call(Fun) -> + Fun(bar, 42, foo, 17). + +dummy_foo(_, _, foo, _) -> ok. + +%%-------------------------------------------------------------------- +%% Tests handling of funs out of exported functions and 2-tuple funs. + +test_fun03() -> + MFPair = add1_as_2tuple(), + 4712 = do_call(add1_as_export(), 4711), + {badfun, MFPair} = try do_call(MFPair, 88) catch error:Err -> Err end, + true = do_guard(add1_as_export()), + false = do_guard(MFPair), % 2-tuples do not satisfy is_function/1 + ok. + +do_call(F, X) -> F(X). + +do_guard(F) when is_function(F) -> true; +do_guard(_) -> false. + +add1_as_export() -> fun ?MODULE:add1/1. + +add1_as_2tuple() -> {?MODULE, add1}. + +add1(X) -> X+1. + +%%-------------------------------------------------------------------- +%% Tests the is_function guard and BIF. + +test_is_function() -> + Fun = fun (X, foo) -> dummy_foo(X, mnesia_lib, foo, [X]) end, + ok = test_when_guard(Fun), + ok = test_if_guard(Fun), + ok. + +test_when_guard(X) when is_function(X) -> ok. + +test_if_guard(X) -> + if is_function(X) -> ok; + true -> weird + end. + +%%-------------------------------------------------------------------- +%% Tests the is_function2 guard and BIF. + +test_is_function2() -> + ok = test_guard(), + ok = test_guard2(), + ok = test_call(), + ok. + +test_guard() -> + zero_fun = test_f2(fun () -> ok end), + unary_fun = test_f2(fun(X) -> X end), + binary_fun = test_f2(fun (X, Y) -> {X, Y} end), + no_fun = test_f2(gazonk), + ok. + +test_f2(Fun) when is_function(Fun, 0) -> + zero_fun; +test_f2(Fun) when is_function(Fun, 1) -> + unary_fun; +test_f2(Fun) when is_function(Fun, 2) -> + binary_fun; +test_f2(_) -> + no_fun. + +test_guard2() -> + zero_fun = test_f2_n(fun () -> ok end, 0), + unary_fun = test_f2_n(fun (X) -> X end, 1), + binary_fun = test_f2_n(fun (X, Y) -> {X, Y} end, 2), + no_fun = test_f2_n(gazonk, 0), + ok. + +test_f2_n(F, N) when is_function(F, N) -> + case N of + 0 -> zero_fun; + 1 -> unary_fun; + 2 -> binary_fun + end; +test_f2_n(_, _) -> + no_fun. + +test_call() -> + true = test_fn2(fun (X, Y) -> {X,Y} end, 2), + false = test_fn2(fun (X, Y) -> {X,Y} end, 3), + false = test_fn2(gazonk, 2), + {'EXIT', {badarg, _TR1}} = (catch test_fn2(gazonk, gazonk)), + {'EXIT', {badarg, _TR2}} = (catch test_fn2(fun (X, Y) -> {X, Y} end, gazonk)), + ok. + +test_fn2(F, N) -> + is_function(F, N). diff --git a/lib/hipe/test/basic_SUITE_data/basic_guards.erl b/lib/hipe/test/basic_SUITE_data/basic_guards.erl new file mode 100644 index 0000000000..81eeed7c3b --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_guards.erl @@ -0,0 +1,164 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests for correct handling of guards and guard BIFs. +%%%------------------------------------------------------------------- +-module(basic_guards). + +-export([test/0]). +%% Prevent the inlining of the following functions +-export([bad_arith/0, bad_tuple/0, is_strange_guard/0]). + +test() -> + ok = guard0(4.2), + ok = guard1([foo]), + ok = test_guard2(), + ok = test_guard3(), + ok = test_guard4(), + ok = test_is_boolean(), + ok = test_bad_guards(), + ok. + +%%-------------------------------------------------------------------- + +guard0(X) when X /= 0, is_float(X) -> + ok. + +guard1(X) when is_atom(X) orelse is_float(X) -> + error1; +guard1(X) when is_reference(hd(X)) -> + error2; +guard1(X) when is_integer(hd(X)) -> + error3; +guard1(X) when hd(X) == foo -> + ok. + +%%-------------------------------------------------------------------- + +test_guard2() -> + ok1 = guard2(true), + not_boolean = guard2(42), + ok2 = guard2(false), + ok. + +guard2(X) when X -> % gets transformed to: is_boolean(X), X =:= true + ok1; +guard2(X) when X =:= false -> + ok2; +guard2(_) -> + not_boolean. + +%%-------------------------------------------------------------------- + +-define(is_foo(X), (is_atom(X) or (is_tuple(X) and (element(1, X) =:= 'foo')))). + +test_guard3() -> + no = f('foo'), + yes = f({'foo', 42}), + no = f(42), + ok. + +f(X) when ?is_foo(X) -> yes; +f(_) -> no. + +%%-------------------------------------------------------------------- + +-define(EXT_REF, <<131,114,0,3,100,0,19,114,101,102,95,116,101,115,116,95,98,117,103,64,103,111,114,98,97,103,2,0,0,0,125,0,0,0,0,0,0,0,0>>). + +test_guard4() -> + yes = is_ref(make_ref()), + no = is_ref(gazonk), + yes = is_ref(an_external_ref(?EXT_REF)), + ok. + +is_ref(Ref) when is_reference(Ref) -> yes; +is_ref(_Ref) -> no. + +an_external_ref(Bin) -> + binary_to_term(Bin). + +%%-------------------------------------------------------------------- + +test_is_boolean() -> + ok = is_boolean_in_if(), + ok = is_boolean_in_guard(). + +is_boolean_in_if() -> + ok1 = tif(true), + ok2 = tif(false), + not_bool = tif(other), + ok. + +is_boolean_in_guard() -> + ok = tg(true), + ok = tg(false), + not_bool = tg(other), + ok. + +tif(V) -> + Yes = yes(), %% just to prevent the optimizer removing this + if + %% the following line generates an is_boolean instruction + V, Yes == yes -> + %% while the following one does not (?!) + %% Yes == yes, V -> + ok1; + not(not(not(V))) -> + ok2; + V -> + ok3; + true -> + not_bool + end. + +tg(V) when is_boolean(V) -> + ok; +tg(_) -> + not_bool. + +yes() -> yes. + +%%-------------------------------------------------------------------- +%% original test by Bjorn G + +test_bad_guards() -> + ok = bad_arith(), + ok = bad_tuple(), + ok = is_strange_guard(), + ok. + +bad_arith() -> + 13 = bad_arith1(1, 12), + 42 = bad_arith1(1, infinity), + 42 = bad_arith1(infinity, 1), + 42 = bad_arith2(infinity, 1), + 42 = bad_arith3(inf), + 42 = bad_arith4(infinity, 1), + ok. + +bad_arith1(T1, T2) when (T1 + T2) < 17 -> T1 + T2; +bad_arith1(_, _) -> 42. + +bad_arith2(T1, T2) when (T1 * T2) < 17 -> T1 * T2; +bad_arith2(_, _) -> 42. + +bad_arith3(T) when (bnot T) < 17 -> T; +bad_arith3(_) -> 42. + +bad_arith4(T1, T2) when (T1 bsr T2) < 10 -> T1 bsr T2; +bad_arith4(_, _) -> 42. + +bad_tuple() -> + error = bad_tuple1(a), + error = bad_tuple1({a, b}), + x = bad_tuple1({x, b}), + y = bad_tuple1({a, b, y}), + ok. + +bad_tuple1(T) when element(1, T) =:= x -> x; +bad_tuple1(T) when element(3, T) =:= y -> y; +bad_tuple1(_) -> error. + +is_strange_guard() when is_tuple({1, bar, length([1, 2, 3, 4]), self()}) -> ok; +is_strange_guard() -> error. diff --git a/lib/hipe/test/basic_SUITE_data/basic_inline_function.erl b/lib/hipe/test/basic_SUITE_data/basic_inline_function.erl new file mode 100644 index 0000000000..4c08064670 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_inline_function.erl @@ -0,0 +1,73 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests that depend on the compiler inliner being turned on. +%%%------------------------------------------------------------------- +-module(basic_inline_function). + +-export([test/0]). + +-compile({inline, [{to_objects, 3}]}). + +test() -> + ok = test_inline_match(), + ok. + +%%-------------------------------------------------------------------- + +test_inline_match() -> + bad_object = test1(a, {binary, foo, set}, c), + bad_object = test2(a, {binary, foo, set}, c), + bad_object = test3(a, {binary, foo, set}, c), + ok. + +%% Inlined +test1(KeysObjs, C, Ts) -> + case catch to_objects(KeysObjs, C, Ts) of + {'EXIT', _} -> + bad_object; + ok -> + ok + end. + +%% "Inlined" by hand +test2(KeysObjs, C, _Ts) -> + case catch (case C of + {binary, _, set} -> + <<_ObjSz0:32, _T/binary>> = KeysObjs; + _ -> ok + end) of + {'EXIT', _} -> + bad_object; + ok -> + ok + end. + +%% Not inlined +test3(KeysObjs, C, Ts) -> + case catch fto_objects(KeysObjs, C, Ts) of + {'EXIT', _} -> + bad_object; + ok -> + ok + end. + +%% Inlined. +to_objects(Bin, {binary, _, set}, _Ts) -> + <<_ObjSz0:32, _T/binary>> = Bin, + ok; +to_objects(<<_ObjSz0:32, _T/binary>> ,_, _) -> + ok; +to_objects(_Bin, _, _Ts) -> + ok. + +%% Not Inlined. +fto_objects(Bin, {binary, _, set}, _Ts) -> + <<_ObjSz0:32, _T/binary>> = Bin, + ok; +fto_objects(<<_ObjSz0:32, _T/binary>> ,_,_) -> + ok; +fto_objects(_Bin, _, _Ts) -> + ok. + diff --git a/lib/hipe/test/basic_SUITE_data/basic_inline_module.erl b/lib/hipe/test/basic_SUITE_data/basic_inline_module.erl new file mode 100644 index 0000000000..306c6a39ce --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_inline_module.erl @@ -0,0 +1,31 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests that depend on the compiler inliner being turned on. +%%%------------------------------------------------------------------- +-module(basic_inline_module). + +-export([test/0]). + +-compile([inline]). %% necessary for these tests + +test() -> + ok = test_case_end_atom(), + ok. + +%%-------------------------------------------------------------------- +%% Tests whether the translation of a case_end instruction works even +%% when an exception (no matching case pattern) is to be raised. + +test_case_end_atom() -> + {'EXIT',{{case_clause,some_atom},_Trace}} = (catch test_case_stm_inlining()), + ok. + +test_case_stm_inlining() -> + case some_atom() of + another_atom -> strange_result + end. + +some_atom() -> + some_atom. diff --git a/lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl b/lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl new file mode 100644 index 0000000000..73367c5c45 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_issues_beam.erl @@ -0,0 +1,326 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains code examples, mostly taken from the mailing list, that +%%% crashed the BEAM compiler or gave an internal error at some point. +%%%------------------------------------------------------------------- +-module(basic_issues_beam). + +-export([test/0]). + +test() -> + ok = test_crash_R10_hinde(), + ok = test_error_R10_mander(), + ok = test_error_R11_bjorklund(), + ok = test_error_R11_rath(), + ok = test_error_R12_empty_bin_rec(), + ok = test_bug_R12_cornish(), + ok = test_crash_R12_morris(), + ok = test_error_R13_almeida(), + ok = test_error_R13B01_fisher(), + ok = test_error_R13B01_sawatari(), + ok = test_error_R13B01_whongo(), + ok = test_error_R16B03_norell(), + ok = test_error_try_wings(), + ok. + +%%-------------------------------------------------------------------- +%% Fisher R10 compiler crash +%%-------------------------------------------------------------------- + +-record(r, {a, b, c}). + +test_crash_R10_hinde() -> + rec_R10_hinde(#r{}). + +rec_R10_hinde(As) -> + case As of + A when A#r.b == ""; A#r.b == undefined -> ok; + _ -> error + end. + +%%-------------------------------------------------------------------- +%% From: Peter-Henry Mander +%% Date: 27 Jan, 2005 +%% +%% I managed to isolate a non-critical BEAM compilation error +%% (internal error in v3_codegen) when compiling the following code: +%%-------------------------------------------------------------------- + +test_error_R10_mander() -> + try just_compile_me_R10() catch _:_ -> ok end. + +just_compile_me_R10() -> + URI_Before = + {absoluteURI, + {scheme, fun() -> nil end}, + {hier_part, + {net_path, + {srvr, + {userinfo, nil}, + fun() -> nil end}, + nil}, + {port, nil}}}, + {absoluteURI, + {scheme, _}, + {hier_part, + {net_path, + {srvr, + {userinfo, nil}, + _HostportBefore}, + nil}, + {port, nil}}} = URI_Before, + %% ... some funky code ommitted, not relevant ... + {absoluteURI, + {scheme, _}, + {hier_part, + {net_path, + {srvr, + {userinfo, nil}, + HostportAfter}, + nil}, + {port, nil}}} = URI_Before, + %% NOTE: I intended to write URI_After instead of URI_Before + %% but the accident revealed that when you add the line below, + %% it causes internal error in v3_codegen on compilation + {hostport, {hostname, "HostName"}, {port, nil}} = HostportAfter, + ok. + +%%-------------------------------------------------------------------- +%% From: Martin Bjorklund +%% Date: Aug 16, 2006 +%% +%% I found this compiler bug in R10B-10 and R11B-0. +%% +%% Function -just_compile_me/0-fun-2-/1 refers to undefined label 18 +%% ./bjorklund_R11compiler_bug.erl:none: internal error in beam_clean; +%% crash reason: {{case_clause,{'EXIT',{undefined_label,18}}}, +%% [{compile,'-select_passes/2-anonymous-2-',2}, +%% {compile,'-internal_comp/4-anonymous-1-',2}, +%% {compile,fold_comp,3}, +%% {compile,internal_comp,4}, +%% {compile,internal,3}]} +%%-------------------------------------------------------------------- + +test_error_R11_bjorklund() -> + just_compile_me_R11_bjorklund(). + +just_compile_me_R11_bjorklund() -> + G = fun() -> ok end, + try + G() %% fun() -> ok end + after + fun({A, B}) -> A + B end + end. + +%%-------------------------------------------------------------------- +%% From: Tim Rath +%% Date: Sep 13, 2006 +%% Subject: Compiler bug not quite fixed +%% +%% +%% I saw a compiler bug posted to the list by Martin Bjorklund that +%% appeared to be exactly the problem I'm seeing, and then noticed +%% that this was fixed in R11B-1. Unfortunately, though R11B-1 appears +%% to fix the code submitted by Martin, it does not fix my case. +%% +%% Function -just_compile_me/0-fun-2-/1 refers to undefined label 13 +%% ./rath_R11compiler_bug.erl:none: internal error in beam_clean; +%% crash reason: {{case_clause,{'EXIT',{undefined_label,13}}}, +%% [{compile,'-select_passes/2-anonymous-2-',2}, +%% {compile,'-internal_comp/4-anonymous-1-',2}, +%% {compile,fold_comp,3}, +%% {compile,internal_comp,4}, +%% {compile,internal,3}]} +%%-------------------------------------------------------------------- + +test_error_R11_rath() -> + just_compile_me_R11_rath(). + +just_compile_me_R11_rath() -> + A = {6}, + try + io:fwrite("") + after + fun () -> + fun () -> {_} = A end + end + end. + +%%---------------------------------------------------------------------- +%% Program that crashed the R12B-0 compiler: internal error in v3_codegen +%%---------------------------------------------------------------------- + +-record(rec, {a = <<>> :: binary(), b = 42 :: integer()}). + +test_error_R12_empty_bin_rec() -> + 42 = test_empty_bin_rec(#rec{}), + ok. + +test_empty_bin_rec(R) -> + #rec{a = <<>>} = R, + R#rec.b. + +%%---------------------------------------------------------------------- +%% From: Simon Cornish +%% Date: Jan 13, 2008 +%% +%% The attached Erlang code demonstrates an R12B-0 bug with funs. +%% Compile and evaluate the two die/1 calls for two different failure modes. +%% It seems to me that the live register check for call_fun is off by one. +%%---------------------------------------------------------------------- + +-record(b, {c}). + +test_bug_R12_cornish() -> + {a2, a} = die(a), + {a2, {b, c}} = die({b, c}), + ok. + +die(A) -> + F = fun() -> {ok, A} end, + if A#b.c =:= [] -> one; + true -> + case F() of + {ok, A2} -> {a2, A2}; + _ -> three + end + end. + +%%---------------------------------------------------------------------- +%% From: Hunter Morris +%% Date: Nov 20, 2008 +%% +%% The following code (tested with R12B-4 or R12B-5, vanilla compiler +%% options) produces a compiler crash. It's nonsensical, and I realise +%% that andalso can be quite evil, but it's a crash nonetheless. +%%---------------------------------------------------------------------- + +test_crash_R12_morris() -> + foo(42). + +foo(Bar) when (is_integer(Bar) andalso Bar =:= 0) ; Bar =:= 42 -> + ok. + +%%-------------------------------------------------------------------- +%% From: Paulo Sergio Almeida +%% Date: May 20, 2009 +%% +%% The following code when compiled under R13B gives a compiler error. +%% Function loop/1 refers to undefined label 6 +%% ./almeida_R13compiler_bug.erl:none: internal error in beam_peep; +%% crash reason: {{case_clause,{'EXIT',{undefined_label,6}}}, +%% [{compile,'-select_passes/2-anonymous-2-',2}, +%% {compile,'-internal_comp/4-anonymous-1-',2}, +%%-------------------------------------------------------------------- + +test_error_R13_almeida() -> + self() ! {backup, 42, false}, + loop([]). + +loop(Tids) -> + receive + {backup, Tid, Dumping} -> + case Dumping of + false -> ok; + _ -> receive {logged, Tab, Tid} -> put({log, Tab}, Tid) end + end, + collect(Tid, Tids, []) + end. + +collect(_, _, _) -> ok. + +%%-------------------------------------------------------------------- +%% Fisher R13B01 compiler error +%%-------------------------------------------------------------------- + +test_error_R13B01_fisher() -> + perform_select({foo, "42"}). + +perform_select({Type, Keyval}) -> + try + if is_atom(Type) andalso length(Keyval) > 0 -> ok; + true -> ok + end + catch + _:_ -> fail + end. + +%%-------------------------------------------------------------------- +%% From: Mikage Sawatari +%% Date: Jun 12, 2009 +%% +%% I have the following compilation problem on Erlang R13B01. +%% Compiler reports "Internal consistency check failed". +%%-------------------------------------------------------------------- + +test_error_R13B01_sawatari() -> + test_sawatari([1, null, 3], <<1, 2, 3>>). + +test_sawatari([], _Bin) -> ok; +test_sawatari([H|T], Bin) -> + _ = case H of + null -> <<Bin/binary>>; + _ -> ok + end, + test_sawatari(T, Bin). + +%%-------------------------------------------------------------------- + +test_error_R13B01_whongo() -> + S = "gazonk", + S = orgno_alphanum(S), + ok. + +orgno_alphanum(Cs) -> + [C || C <- Cs, ((C >= $0) andalso (C =< $9)) + orelse ((C >= $a) andalso (C =< $z)) + orelse ((C >= $A) andalso (C =< $Z))]. + +%%-------------------------------------------------------------------- +%% I'm getting an Internal Consistency Check error when attempting to +%% build Wings3D on Mac OS X 10.4.2 (Erlang OTP R10B-6): +%% +%% erlc -pa /ebin +warn_unused_vars -I/include -I ../e3d -W +debug_info +%% '-Dwings_version="0.98.31"' -pa ../ebin -o../ebin wings_color.erl +%% wings_color: function internal_rgb_to_hsv/3+97: +%% Internal consistency check failed - please report this bug. +%% Instruction: {test,is_eq_exact,{f,80},[{x,0},{atom,error}]} +%% Error: {unsafe_instruction,{float_error_state,cleared}}: +%% +%% The problem is the interaction of the 'try' construct with the +%% handling of FP exceptions. +%%-------------------------------------------------------------------- + +test_error_try_wings() -> + %% a call with a possible FP exception + {199.99999999999997, 0.045454545454545456, 44} = rgb_to_hsv(42, 43, 44), + ok. + +rgb_to_hsv(R, G, B) -> + Max = lists:max([R, G, B]), + Min = lists:min([R, G, B]), + V = Max, + {Hue, Sat} = try + {if Min == B -> (G-Min)/(R+G-2.0*Min); + Min == R -> (1.0+(B-Min)/(B+G-2.0*Min)); + Min == G -> (2.0+(R-Min)/(B+R-2.0*Min)) + end * 120, (Max-Min)/Max} + catch + error:badarith -> {undefined, 0.0} + end, + {Hue, Sat, V}. + +%%-------------------------------------------------------------------- +%% From: Ulf Norell +%% Date: Feb 28, 2014 +%% +%% This caused an internal error in v3_codegen +%%-------------------------------------------------------------------- + +test_error_R16B03_norell() -> + test_error_R16B03_norell(#r{}, gazonk). + +test_error_R16B03_norell(Rec, Tag) -> + is_record(Rec, Tag, 3) orelse ok. diff --git a/lib/hipe/test/basic_SUITE_data/basic_issues_hipe.erl b/lib/hipe/test/basic_SUITE_data/basic_issues_hipe.erl new file mode 100644 index 0000000000..e71045bfe2 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_issues_hipe.erl @@ -0,0 +1,153 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains code examples that exhibited crashes in the HiPE compiler. +%%%------------------------------------------------------------------- +-module(basic_issues_hipe). + +-export([test/0]). + +%% functions that need to be exported so that they are retained. +-export([auth/4]). + +test() -> + ok = test_dominance_trees(), + ok = test_merged_const(), + ok = test_var_pair(), + ok = test_bif_fails(), + ok = test_find_catches(), + ok = test_heap_allocate_trim(), + ok. + +%%-------------------------------------------------------------------- +%% This is taken from a file sent to us by Martin Bjorklund @ Nortel +%% on 14th November 2004. The problem was in the SSA unconvert pass. +%% +%% No tests here; we simply check that the HiPE compiler does not go +%% into an infinite loop when compiling strange functions like this. +%%-------------------------------------------------------------------- + +auth(_, A, B, C) -> + auth(A, B, C, []). + +%%-------------------------------------------------------------------- +%% Exposed a crash in the generation of dominance trees used in SSA. +%%-------------------------------------------------------------------- + +-record(state, {f}). + +test_dominance_trees() -> + {ok, true} = doit(true, #state{f = true}), + ok. + +doit(Foo, S) -> + Fee = case Foo of + Bar when Bar == S#state.f; Bar == [] -> true; + _ -> false + end, + {ok, Fee}. + +%%-------------------------------------------------------------------- +%% Checks that the merging of constants in the constant table uses the +%% appropriate comparison function for this. +%%-------------------------------------------------------------------- + +test_merged_const() -> + Const1 = {'', 1.0000}, + Const2 = {'', 1}, + match(Const1, Const2). + +match(A, A) -> + error; +match(_A, _B) -> + ok. + +%%-------------------------------------------------------------------- +%% Checks that the HiPE compiler does not get confused by constant +%% data structures similar to the internal compiler data structures. +%%-------------------------------------------------------------------- + +test_var_pair() -> + ok = var_pair([gazonk]). + +var_pair([_|_]) -> + var_pair({var, some_atom}); +var_pair(_) -> + ok. + +%%-------------------------------------------------------------------- +%% This module was causing the HiPE compiler to crash in January 2007. +%% The culprit was an "optimization" of the BEAM compiler: postponing +%% the save of x variables when BIFs cannot fail. This was fixed on +%% February 1st, by making the HiPE compiler use the same functions +%% as the BEAM compiler for deciding whether a BIF fails. +%%-------------------------------------------------------------------- + +test_bif_fails() -> + [42] = bif_fails_in_catch([42]), + true = bif_fails_in_try([42]), + ok. + +bif_fails_in_catch(X) -> + case catch get(gazonk) of + _ -> X + end. + +bif_fails_in_try(X) -> + try + true = X =/= [] + catch + _ -> nil(X) + end. + +nil(_) -> []. + +%%-------------------------------------------------------------------- +%% Test that resulted in a native code compiler crash in the code of +%% hipe_icode_exceptions:find_catches/1 when compiling find_catches/2. +%%-------------------------------------------------------------------- + +test_find_catches() -> + 42 = find_catches(a, false), + ok. + +find_catches(X, Y) -> + case X of + a when Y =:= true -> + catch id(X), + X; + b when Y =:= true -> + catch id(X), + X; + a -> + catch id(X), + 42; + b -> + catch id(X), + 42 + end. + +id(X) -> X. + +%%-------------------------------------------------------------------- +%% Date: Dec 28, 2007 +%% +%% This is a test adapted from the file sent to the Erlang mailing +%% list by Eranga Udesh. The file did not compile because of problems +%% with the heap_allocate instruction and stack trimming. +%%-------------------------------------------------------------------- + +test_heap_allocate_trim() -> + {abandon, 42} = get_next_retry(a, 42), + ok. + +get_next_retry(Error, Count) -> + case catch pair(retry_scheme, {Error, Count}) of + _ -> + case pair(Error, Count) of + _ -> {abandon, Count} + end + end. + +pair(A, B) -> {A, B}. diff --git a/lib/hipe/test/basic_SUITE_data/basic_lists.erl b/lib/hipe/test/basic_SUITE_data/basic_lists.erl new file mode 100644 index 0000000000..264a7f86f6 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_lists.erl @@ -0,0 +1,61 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests that manipulate and pattern match against lists +%%% (perhaps by calling functions from the 'lists' module). +%%%------------------------------------------------------------------- +-module(basic_lists). + +-export([test/0]). + +test() -> + ok = test_length(), + ok = test_lists_key(), + ok = test_lists_and_strings(), + ok. + +%%-------------------------------------------------------------------- + +test_length() -> + Len = 42, + Lst = mklist(Len, []), + Len = iterate(100, Lst), + ok. + +mklist(0, L) -> L; +mklist(X, L) -> mklist(X-1, [X|L]). + +iterate(0, L) -> len(L, 0); +iterate(X, L) -> len(L, 0), iterate(X-1, L). + +len([_|X], L) -> len(X, L+1); +len([], L) -> L. + +%%-------------------------------------------------------------------- + +test_lists_key() -> + First = {x, 42.0}, + Second = {y, -77}, + Third = {z, [a, b, c], {5.0}}, + List = [First, Second, Third], + {value, First} = key_search_find(42, 2, List), + ok. + +key_search_find(Key, Pos, List) -> + case lists:keyfind(Key, Pos, List) of + false -> + false = lists:keysearch(Key, Pos, List); + Tuple when is_tuple(Tuple) -> + {value, Tuple} = lists:keysearch(Key, Pos, List) + end. + +%%-------------------------------------------------------------------- + +test_lists_and_strings() -> + LL = ["H'A", " H'B", " H'C"], + LL2 = lists:map(fun string:strip/1, LL), + HexFormat = fun(X, Acc) -> {string:substr(X, 3), Acc} end, + {LL3,_Ret} = lists:mapfoldl(HexFormat, 0, LL2), + ["A", "B", "C"] = lists:sublist(LL3, 42), + ok. diff --git a/lib/hipe/test/basic_SUITE_data/basic_module_info.erl b/lib/hipe/test/basic_SUITE_data/basic_module_info.erl new file mode 100644 index 0000000000..cab48b10ba --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_module_info.erl @@ -0,0 +1,32 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% Date: Oct 25, 2003 +%%% +%%% Tests whether calling module_info from the same module works. +%%% This seems trivial, but the problem is that the module_info/[0,1] +%%% functions that the BEAM file contains used to be dummy functions +%%% containing crap. So, these functions could not be used for +%%% compilation to native code and the functions that the BEAM loader +%%% generates should have been used instead. This was a HiPE bug +%%% reported by Dan Wallin. +%%%------------------------------------------------------------------- +-module(basic_module_info). + +-export([test/0]). + +test() -> + L = test_local_mi0_call(), + E = test_remote_mi1_call(), + {3, 3} = {L, E}, + ok. + +test_local_mi0_call() -> + ModInfo = module_info(), + %% io:format("ok, ModInfo=~w\n", [ModInfo]), + {exports, FunList} = lists:keyfind(exports, 1, ModInfo), + length(FunList). + +test_remote_mi1_call() -> + FunList = ?MODULE:module_info(exports), + length(FunList). diff --git a/lib/hipe/test/basic_SUITE_data/basic_pattern_match.erl b/lib/hipe/test/basic_SUITE_data/basic_pattern_match.erl new file mode 100644 index 0000000000..93240354a7 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_pattern_match.erl @@ -0,0 +1,46 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains code examples that test pattern matching against terms of +%%% various types. +%%%------------------------------------------------------------------- +-module(basic_pattern_match). + +-export([test/0]). + +test() -> + ok = test_hello_world(), + ok = test_list_plus_plus_match(), + ok. + +%%-------------------------------------------------------------------- +%% Trivial test to test pattern matching compilation with atoms, the +%% correct handling of all sorts of alphanumeric types in Erlang, and +%% conversions between them. + +test_hello_world() -> + String = gimme(string), + String = atom_to_list(gimme(atom)), + String = binary_to_list(gimme(binary)), + true = (list_to_atom(String) =:= gimme(atom)), + true = (list_to_binary(String) =:= gimme(binary)), + ok. + +gimme(string) -> + "hello world"; +gimme(atom) -> + 'hello world'; +gimme(binary) -> + <<"hello world">>. + +%%-------------------------------------------------------------------- +%% Makes sure that pattern matching expressions involving ++ work OK. +%% The third expression caused a problem in the Erlang shell of R11B-5. +%% It worked OK in both interpreted and compiled code. + +test_list_plus_plus_match() -> + ok = (fun("X" ++ _) -> ok end)("X"), + ok = (fun([$X | _]) -> ok end)("X"), + ok = (fun([$X] ++ _) -> ok end)("X"), + ok. diff --git a/lib/hipe/test/basic_SUITE_data/basic_random.erl b/lib/hipe/test/basic_SUITE_data/basic_random.erl new file mode 100644 index 0000000000..783947bd31 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_random.erl @@ -0,0 +1,238 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% A test for list handling created using the 'random' module. +%%%------------------------------------------------------------------- +-module(basic_random). + +-export([test/0]). + +%% It can be used as a benchmark by playing with the following defines +-define(N, 1000). +-define(Iter, 500). + +test() -> + ok = random(?N). + +random(N) -> + random(N, ?Iter). + +random(N, Iter) -> + random:seed(1, 2, 3), + t(ranlist(N, [], N*100), Iter). + +ranlist(0, L, _N) -> L; +ranlist(N, L, N0) -> ranlist(N-1, [random:uniform(N0)+300 | L], N0). + +t(_, 0) -> ok; +t(L, Iter) -> + %% io:format("Sort starting~n"), + sort(L), + t(L, Iter-1). + +sort([X, Y | L]) when X =< Y -> + split_1(X, Y, L, [], []); +sort([X, Y | L]) -> + split_2(X, Y, L, [], []); +sort(L) -> + L. + +%% Ascending. +split_1(X, Y, [Z | L], R, Rs) when Z >= Y -> + split_1(Y, Z, L, [X | R], Rs); +split_1(X, Y, [Z | L], R, Rs) when Z >= X -> + split_1(Z, Y, L, [X | R], Rs); +split_1(X, Y, [Z | L], [], Rs) -> + split_1(X, Y, L, [Z], Rs); +split_1(X, Y, [Z | L], R, Rs) -> + split_1_1(X, Y, L, R, Rs, Z); +split_1(X, Y, [], R, Rs) -> + rmergel([[Y, X | R] | Rs], []). + +%% One out-of-order element, S. +split_1_1(X, Y, [Z | L], R, Rs, S) when Z >= Y -> + split_1_1(Y, Z, L, [X | R], Rs, S); +split_1_1(X, Y, [Z | L], R, Rs, S) when Z >= X -> + split_1_1(Z, Y, L, [X | R], Rs, S); +split_1_1(X, Y, [Z | L], R, Rs, S) when S =< Z -> + split_1(S, Z, L, [], [[Y, X | R] | Rs]); +split_1_1(X, Y, [Z | L], R, Rs, S) -> + split_1(Z, S, L, [], [[Y, X | R] | Rs]); +split_1_1(X, Y, [], R, Rs, S) -> + rmergel([[S], [Y, X | R] | Rs], []). + +%% Descending. +split_2(X, Y, [Z | L], R, Rs) when Z =< Y -> + split_2(Y, Z, L, [X | R], Rs); +split_2(X, Y, [Z | L], R, Rs) when Z =< X -> + split_2(Z, Y, L, [X | R], Rs); +split_2(X, Y, [Z | L], [], Rs) -> + split_2(X, Y, L, [Z], Rs); +split_2(X, Y, [Z | L], R, Rs) -> + split_2_1(X, Y, L, R, Rs, Z); +split_2(X, Y, [], R, Rs) -> + mergel([[Y, X | R] | Rs], []). + +split_2_1(X, Y, [Z | L], R, Rs, S) when Z =< Y -> + split_2_1(Y, Z, L, [X | R], Rs, S); +split_2_1(X, Y, [Z | L], R, Rs, S) when Z =< X -> + split_2_1(Z, Y, L, [X | R], Rs, S); +split_2_1(X, Y, [Z | L], R, Rs, S) when S > Z -> + split_2(S, Z, L, [], [[Y, X | R] | Rs]); +split_2_1(X, Y, [Z | L], R, Rs, S) -> + split_2(Z, S, L, [], [[Y, X | R] | Rs]); +split_2_1(X, Y, [], R, Rs, S) -> + mergel([[S], [Y, X | R] | Rs], []). + +mergel([[] | L], Acc) -> + mergel(L, Acc); +mergel([A, [H2 | T2], [H3 | T3] | L], Acc) -> + mergel(L, [merge3_1(A, [], H2, T2, H3, T3) | Acc]); +mergel([A, [H | T]], Acc) -> + rmergel([merge2_1(A, H, T, []) | Acc], []); +mergel([L], []) -> + L; +mergel([L], Acc) -> + rmergel([lists:reverse(L, []) | Acc], []); +mergel([], []) -> + []; +mergel([], Acc) -> + rmergel(Acc, []); +mergel([A, [] | L], Acc) -> + mergel([A | L], Acc); +mergel([A, B, [] | L], Acc) -> + mergel([A, B | L], Acc). + +rmergel([A, [H2 | T2], [H3 | T3] | L], Acc) -> + rmergel(L, [rmerge3_1(A, [], H2, T2, H3, T3) | Acc]); +rmergel([A, [H | T]], Acc) -> + mergel([rmerge2_1(A, H, T, []) | Acc], []); +rmergel([L], Acc) -> + mergel([lists:reverse(L, []) | Acc], []); +rmergel([], Acc) -> + mergel(Acc, []). + +%% Take L1 apart. +merge3_1([H1 | T1], M, H2, T2, H3, T3) when H1 =< H2 -> + merge3_12(T1, H1, H2, T2, H3, T3, M); +merge3_1([H1 | T1], M, H2, T2, H3, T3) -> + merge3_21(T1, H1, H2, T2, H3, T3, M); +merge3_1(_nil, M, H2, T2, H3, T3) when H2 =< H3 -> + merge2_1(T2, H3, T3, [H2 | M]); +merge3_1(_nil, M, H2, T2, H3, T3) -> + merge2_1(T3, H2, T2, [H3 | M]). + +%% Take L2 apart. +merge3_2(T1, H1, M, [H2 | T2], H3, T3) when H1 =< H2 -> + merge3_12(T1, H1, H2, T2, H3, T3, M); +merge3_2(T1, H1, M, [H2 | T2], H3, T3) -> + merge3_21(T1, H1, H2, T2, H3, T3, M); +merge3_2(T1, H1, M, _nil, H3, T3) when H1 =< H3 -> + merge2_1(T1, H3, T3, [H1 | M]); +merge3_2(T1, H1, M, _nil, H3, T3) -> + merge2_1(T3, H1, T1, [H3 | M]). + +%% H1 <= H2. Inlined. +merge3_12(T1, H1, H2, T2, H3, T3, M) when H3 < H1 -> + merge3_12_3(T1, H1, H2, T2, [H3 | M], T3); +merge3_12(T1, H1, H2, T2, H3, T3, M) -> + merge3_1(T1, [H1 | M], H2, T2, H3, T3). + +%% H1 <= H2, take L3 apart. +merge3_12_3(T1, H1, H2, T2, M, [H3 | T3]) when H3 < H1 -> + merge3_12_3(T1, H1, H2, T2, [H3 | M], T3); +merge3_12_3(T1, H1, H2, T2, M, [H3 | T3]) -> + merge3_1(T1, [H1 | M], H2, T2, H3, T3); +merge3_12_3(T1, H1, H2, T2, M, _nil) -> + merge2_1(T1, H2, T2, [H1 | M]). + +%% H1 > H2. Inlined. +merge3_21(T1, H1, H2, T2, H3, T3, M) when H3 < H2 -> + merge3_21_3(T1, H1, H2, T2, [H3 | M], T3); +merge3_21(T1, H1, H2, T2, H3, T3, M) -> + merge3_2(T1, H1, [H2 | M], T2, H3, T3). + +%% H1 > H2, take L3 apart. +merge3_21_3(T1, H1, H2, T2, M, [H3 | T3]) when H3 < H2 -> + merge3_21_3(T1, H1, H2, T2, [H3 | M], T3); +merge3_21_3(T1, H1, H2, T2, M, [H3 | T3]) -> + merge3_2(T1, H1, [H2 | M], T2, H3, T3); +merge3_21_3(T1, H1, H2, T2, M, _nil) -> + merge2_1(T2, H1, T1, [H2 | M]). + +%% Take L1 apart. +rmerge3_1([H1 | T1], M, H2, T2, H3, T3) when H1 > H2 -> + rmerge3_12(T1, H1, H2, T2, H3, T3, M); +rmerge3_1([H1 | T1], M, H2, T2, H3, T3) -> + rmerge3_21(T1, H1, H2, T2, H3, T3, M); +rmerge3_1(_nil, M, H2, T2, H3, T3) when H2 > H3 -> + rmerge2_1(T2, H3, T3, [H2 | M]); +rmerge3_1(_nil, M, H2, T2, H3, T3) -> + rmerge2_1(T3, H2, T2, [H3 | M]). + +%% Take L2 apart. +rmerge3_2(T1, H1, M, [H2 | T2], H3, T3) when H1 > H2 -> + rmerge3_12(T1, H1, H2, T2, H3, T3, M); +rmerge3_2(T1, H1, M, [H2 | T2], H3, T3) -> + rmerge3_21(T1, H1, H2, T2, H3, T3, M); +rmerge3_2(T1, H1, M, _nil, H3, T3) when H1 > H3 -> + rmerge2_1(T1, H3, T3, [H1 | M]); +rmerge3_2(T1, H1, M, _nil, H3, T3) -> + rmerge2_1(T3, H1, T1, [H3 | M]). + +%% H1 > H2. Inlined. +rmerge3_12(T1, H1, H2, T2, H3, T3, M) when H3 >= H1 -> + rmerge3_12_3(T1, H1, H2, T2, [H3 | M], T3); +rmerge3_12(T1, H1, H2, T2, H3, T3, M) -> + rmerge3_1(T1, [H1 | M], H2, T2, H3, T3). + +%% H1 > H2, take L3 apart. +rmerge3_12_3(T1, H1, H2, T2, M, [H3 | T3]) when H3 >= H1 -> + rmerge3_12_3(T1, H1, H2, T2, [H3 | M], T3); +rmerge3_12_3(T1, H1, H2, T2, M, [H3 | T3]) -> + rmerge3_1(T1, [H1 | M], H2, T2, H3, T3); +rmerge3_12_3(T1, H1, H2, T2, M, _nil) -> + rmerge2_1(T1, H2, T2, [H1 | M]). + +%% H1 =< H2. Inlined. +rmerge3_21(T1, H1, H2, T2, H3, T3, M) when H3 >= H2 -> + rmerge3_21_3(T1, H1, H2, T2, [H3 | M], T3); +rmerge3_21(T1, H1, H2, T2, H3, T3, M) -> + rmerge3_2(T1, H1, [H2 | M], T2, H3, T3). + +%% H1 =< H2, take L3 apart. +rmerge3_21_3(T1, H1, H2, T2, M, [H3 | T3]) when H3 >= H2 -> + rmerge3_21_3(T1, H1, H2, T2, [H3 | M], T3); +rmerge3_21_3(T1, H1, H2, T2, M, [H3 | T3]) -> + rmerge3_2(T1, H1, [H2 | M], T2, H3, T3); +rmerge3_21_3(T1, H1, H2, T2, M, _nil) -> + rmerge2_1(T2, H1, T1, [H2 | M]). + +merge2_1([H1 | T1], H2, T2, M) when H2 < H1 -> + merge2_2(T1, H1, T2, [H2 | M]); +merge2_1([H1 | T1], H2, T2, M) -> + merge2_1(T1, H2, T2, [H1 | M]); +merge2_1(_nil, H2, T2, M) -> + lists:reverse(T2, [H2 | M]). + +merge2_2(T1, H1, [H2 | T2], M) when H1 < H2 -> + merge2_1(T1, H2, T2, [H1 | M]); +merge2_2(T1, H1, [H2 | T2], M) -> + merge2_2(T1, H1, T2, [H2 | M]); +merge2_2(T1, H1, _nil, M) -> + lists:reverse(T1, [H1 | M]). + +rmerge2_1([H1 | T1], H2, T2, M) when H2 >= H1 -> + rmerge2_2(T1, H1, T2, [H2 | M]); +rmerge2_1([H1 | T1], H2, T2, M) -> + rmerge2_1(T1, H2, T2, [H1 | M]); +rmerge2_1(_nil, H2, T2, M) -> + lists:reverse(T2, [H2 | M]). + +rmerge2_2(T1, H1, [H2 | T2], M) when H1 >= H2 -> + rmerge2_1(T1, H2, T2, [H1 | M]); +rmerge2_2(T1, H1, [H2 | T2], M) -> + rmerge2_2(T1, H1, T2, [H2 | M]); +rmerge2_2(T1, H1, _nil, M) -> + lists:reverse(T1, [H1 | M]). diff --git a/lib/hipe/test/basic_SUITE_data/basic_receive.erl b/lib/hipe/test/basic_SUITE_data/basic_receive.erl new file mode 100644 index 0000000000..5f865d7b7a --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_receive.erl @@ -0,0 +1,56 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains code examples that test correct handling of receives. +%%%------------------------------------------------------------------- +-module(basic_receive). + +-export([test/0]). + +test() -> + ok = test_wait_timeout(), + ok = test_double_timeout(), + ok = test_reschedule(), + ok. + +%%-------------------------------------------------------------------- + +test_wait_timeout() -> + receive after 42 -> ok end. + +%%-------------------------------------------------------------------- + +test_double_timeout() -> + self() ! foo, + self() ! another_foo, + receive + non_existent -> weird + after 0 -> timeout + end, + receive + foo -> ok + after 1000 -> timeout + end. + +%%-------------------------------------------------------------------- +%% Check that RESCHEDULE returns from BIFs work. + +test_reschedule() -> + erts_debug:set_internal_state(available_internal_state, true), + First = self(), + Second = spawn(fun() -> doit(First) end), + receive + Second -> ok + end, + receive + after 42 -> ok + end, + erts_debug:set_internal_state(hipe_test_reschedule_resume, Second), + ok. + +doit(First) -> + First ! self(), + erts_debug:set_internal_state(hipe_test_reschedule_suspend, 1). + +%%-------------------------------------------------------------------- diff --git a/lib/hipe/test/basic_SUITE_data/basic_records.erl b/lib/hipe/test/basic_SUITE_data/basic_records.erl new file mode 100644 index 0000000000..cbb451196c --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_records.erl @@ -0,0 +1,28 @@ +%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests that manipulate and pattern match against records. +%%%------------------------------------------------------------------- +-module(basic_records). + +-export([test/0]). + +test() -> + ok = test_rec1(), + ok. + +%%-------------------------------------------------------------------- + +-record(r, {ra}). +-record(s, {sa, sb, sc, sd}). + +test_rec1() -> + R = #r{}, + S = #s{}, + S1 = S#s{sc=R, sd=1}, + R1 = S1#s.sc, + undefined = R1#r.ra, + ok. + +%%-------------------------------------------------------------------- diff --git a/lib/hipe/test/basic_SUITE_data/basic_strength_reduce.erl b/lib/hipe/test/basic_SUITE_data/basic_strength_reduce.erl new file mode 100644 index 0000000000..0f94320a33 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_strength_reduce.erl @@ -0,0 +1,65 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Tests the strength reduction component of the HiPE compiler. +%%%------------------------------------------------------------------- +-module(basic_strength_reduce). + +-export([test/0]). +%% These functions are exported so as to not remove them by inlining +-export([crash_0/1, crash_1/1, crash_2/1, crash_3/1, bug_div_2N/1]). + +test() -> + ok = test_strength_reduce1(), + ok. + +%%-------------------------------------------------------------------- + +test_strength_reduce1() -> + ok = crash_0(0), + ok = crash_1(42), + ok = crash_2(42), + ok = crash_3(42), + 5 = 42 bsr 3 = bug_div_2N(42), + -6 = -42 bsr 3 = bug_div_2N(-42) - 1, + ok. + +%% This is a crash report by Peter Wang (10 July 2007) triggering an +%% R11B-5 crash: strength reduction could not handle calls with no +%% destination +crash_0(A) -> + case A of + 0 -> + A div 8, + ok + end. + +%% The above was simplified to the following which showed another +%% crash, this time on RTL +crash_1(A) when is_integer(A), A >= 0 -> + A div 8, + ok. + +%% A similar crash like the first one, but in a different place in the +%% code, was triggered by the following code +crash_2(A) when is_integer(A), A >= 0 -> + A div 1, + ok. + +%% A crash similar to the first one happened in the following code +crash_3(A) -> + case A of + 42 -> + A * 0, + ok + end. + +%% Strength reduction for div/2 and rem/2 with a power of 2 +%% should be performed only for non-negative integers +bug_div_2N(X) when is_integer(X), X >= 0 -> + X div 8; +bug_div_2N(X) when is_integer(X), X < 0 -> + X div 8. + +%%-------------------------------------------------------------------- diff --git a/lib/hipe/test/basic_SUITE_data/basic_switches.erl b/lib/hipe/test/basic_SUITE_data/basic_switches.erl new file mode 100644 index 0000000000..0a7ae5b8b7 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_switches.erl @@ -0,0 +1,52 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests for pattern matching switches. +%%%------------------------------------------------------------------- +-module(basic_switches). + +-export([test/0]). + +test() -> + ok = test_switch_mix(), + ok. + +%%--------------------------------------------------------------------- + +-define(BIG1, 21323233222132323322). +-define(BIG2, 4242424242424242424242424242424242). + +test_switch_mix() -> + small1 = t(42), + small2 = t(17), + big1 = t(?BIG1), + big2 = t(?BIG2), + atom = t(foo), + pid = t(self()), + float = t(4.2), + ok. + +t(V) -> + S = self(), + case V of + 42 -> small1; + 17 -> small2; + ?BIG1 -> big1; + ?BIG2 -> big2; + 1 -> no; + 2 -> no; + 3 -> no; + 4 -> no; + 5 -> no; + 6 -> no; + 7 -> no; + 8 -> no; + foo -> atom; + 9 -> no; + 4.2 -> float; + S -> pid; + _ -> no + end. + +%%--------------------------------------------------------------------- diff --git a/lib/hipe/test/basic_SUITE_data/basic_tail_rec.erl b/lib/hipe/test/basic_SUITE_data/basic_tail_rec.erl new file mode 100644 index 0000000000..0124f13df6 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_tail_rec.erl @@ -0,0 +1,39 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests that check that tail recursion optimization occurs. +%%%------------------------------------------------------------------- +-module(basic_tail_rec). + +-export([test/0]). +-export([app0/2]). %% used in an apply/3 call + +test() -> + ok = test_app_tail(), + ok. + +%%-------------------------------------------------------------------- +%% Written by Mikael Pettersson: check that apply is tail recursive. + +%% Increased the following quantity from 20 to 30 so that the test +%% remains valid even with the naive register allocator. - Kostis +-define(SIZE_INCREASE, 30). + +test_app_tail() -> + Inc = start(400), + %% io:format("Inc ~w\n", [Inc]), + case Inc > ?SIZE_INCREASE of + true -> + {error, "apply/3 is not tail recursive in native code"}; + false -> + ok + end. + +start(N) -> + app0(N, hipe_bifs:nstack_used_size()). + +app0(0, Size0) -> + hipe_bifs:nstack_used_size() - Size0; +app0(N, Size) -> + apply(?MODULE, app0, [N-1, Size]). diff --git a/lib/hipe/test/basic_SUITE_data/basic_tuples.erl b/lib/hipe/test/basic_SUITE_data/basic_tuples.erl new file mode 100644 index 0000000000..94c187e364 --- /dev/null +++ b/lib/hipe/test/basic_SUITE_data/basic_tuples.erl @@ -0,0 +1,177 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Contains tests that manipulate and pattern match against tuples. +%%%------------------------------------------------------------------- +-module(basic_tuples). + +-export([test/0]). + +test() -> + Num = 4711, + ok = test_match({}, {1}, {1,2}, {1,2,3}, {1,2,3,4}, {1,2,3,4,5}, + {1,2,3,4,5,6}, {1,2,3,4,5,6,7}, {1,2,3,4,5,6,7,8}), + ok = test_size({}, {a}, {{a},{b}}, {a,{b},c}), + ok = test_element({}, {a}, {a,b}, Num), + ok = test_setelement({}, {1}, {1,2}, 3, [1,2]), + ok = test_tuple_to_list({}, {a}, {a,b}, {a,b,c}, {a,b,c,d}, Num), + ok = test_list_to_tuple([], [a], [a,b], [a,b,c], [a,b,c,d], Num), + ok = test_tuple_with_case(), + ok = test_tuple_in_guard({a, b}, {a, b, c}), + ok. + +%%-------------------------------------------------------------------- +%% Tests matching of tuples + +test_match(T0, T1, T2, T3, T4, T5, T6, T7, T8) -> + {} = T0, + {1} = T1, + {1, 2} = T2, + {1, 2, 3} = T3, + {1, 2, 3, 4} = T4, + {1, 2, 3, 4, 5} = T5, + {1, 2, 3, 4, 5, 6} = T6, + T6 = {1, 2, 3, 4, 5, 6}, + T7 = {1, 2, 3, 4, 5, 6, 7}, + {1, 2, 3, 4, 5, 6, 7, 8} = T8, + ok. + +%%-------------------------------------------------------------------- +%% Tests the size/1 and tuple_size/1 BIFs. + +test_size(T0, T1, T2, T3) -> + [0, 1, 2, 3] = [size(T) || T <- [T0, T1, T2, T3]], + [0, 1, 2, 3] = [tuple_size(T) || T <- [T0, T1, T2, T3]], + ok. + +%%-------------------------------------------------------------------- +%% Tests element/2. + +test_element(T0, T1, T2, N) -> + a = element(1, T1), + a = element(1, T2), + %% indirect calls to element/2 + List = lists:seq(1, N), + Tuple = list_to_tuple(List), + ok = get_elements(List, Tuple, 1), + %% some cases that throw exceptions + {'EXIT', _} = (catch my_element(0, T2)), + {'EXIT', _} = (catch my_element(3, T2)), + {'EXIT', _} = (catch my_element(1, T0)), + {'EXIT', _} = (catch my_element(1, List)), + {'EXIT', _} = (catch my_element(1, N)), + {'EXIT', _} = (catch my_element(1.5, T2)), + ok. + +my_element(Pos, Term) -> + element(Pos, Term). + +get_elements([Element|Rest], Tuple, Pos) -> + Element = element(Pos, Tuple), + get_elements(Rest, Tuple, Pos + 1); +get_elements([], _Tuple, _Pos) -> + ok. + +%%-------------------------------------------------------------------- +%% Tests set_element/3. + +test_setelement(T0, T1, Pair, Three, L) -> + {x} = setelement(1, T1, x), + {x, 2} = setelement(1, Pair, x), + {1, x} = setelement(2, Pair, x), + %% indirect calls to setelement/3 + Tuple = list_to_tuple(lists:duplicate(2048, x)), + NewTuple = set_all_elements(Tuple, 1), + NewTuple = list_to_tuple(lists:seq(1+7, 2048+7)), + %% the following cases were rewritten to use the Three + %% variable in this weird way so as to silence the compiler + {'EXIT', _} = (catch setelement(Three - Three, Pair, x)), + {'EXIT', _} = (catch setelement(Three, Pair, x)), + {'EXIT', _} = (catch setelement(Three div Three, T0, x)), + {'EXIT', _} = (catch setelement(Three div Three, L, x)), + {'EXIT', _} = (catch setelement(Three / 2, Pair, x)), + ok. + +set_all_elements(Tuple, Pos) when Pos =< tuple_size(Tuple) -> + set_all_elements(setelement(Pos, Tuple, Pos+7), Pos+1); +set_all_elements(Tuple, Pos) when Pos > tuple_size(Tuple) -> + Tuple. + +%%-------------------------------------------------------------------- +%% Tests tuple_to_list/1. + +test_tuple_to_list(T0, T1, T2, T3, T4, Size) -> + [] = tuple_to_list(T0), + [a] = tuple_to_list(T1), + [a, b] = tuple_to_list(T2), + [a, b, c] = tuple_to_list(T3), + [a, b, c, d] = tuple_to_list(T4), + [a, b, c, d] = tuple_to_list(T4), + %% test a big tuple + List = lists:seq(1, Size), + Tuple = list_to_tuple(List), + Size = tuple_size(Tuple), + List = tuple_to_list(Tuple), + %% some cases that should result in errors + {'EXIT', _} = (catch my_tuple_to_list(element(2, T3))), + {'EXIT', _} = (catch my_tuple_to_list(Size)), + ok. + +my_tuple_to_list(X) -> + tuple_to_list(X). + +%%-------------------------------------------------------------------- +%% Tests list_to_tuple/1. + +test_list_to_tuple(L0, L1, L2, L3, L4, Size) -> + {} = list_to_tuple(L0), + {a} = list_to_tuple(L1), + {a, b} = list_to_tuple(L2), + {a, b, c} = list_to_tuple(L3), + {a, b, c, d} = list_to_tuple(L4), + {a, b, c, d, e} = list_to_tuple(L4++[e]), + %% test list_to_tuple with a big list + Tuple = list_to_tuple(lists:seq(1, Size)), + Size = tuple_size(Tuple), + %% some cases that should result in errors + {'EXIT', _} = (catch my_list_to_tuple({a,b})), + {'EXIT', _} = (catch my_list_to_tuple([hd(L1)|hd(L2)])), + ok. + +my_list_to_tuple(X) -> + list_to_tuple(X). + +%%-------------------------------------------------------------------- +%% Tests that a case nested inside a tuple is ok. +%% (This was known to crash earlier versions of BEAM.) + +test_tuple_with_case() -> + {reply, true} = tuple_with_case(), + ok. + +tuple_with_case() -> + %% The following comments apply to the BEAM compiler. + void(), % Reset var count. + {reply, % Compiler will choose {x,1} for tuple. + case void() of % Call will reset var count. + {'EXIT', Reason} -> % Case will return in {x,1} (first free), + {error, Reason}; % but the tuple will be build in {x,1}, + _ -> % so case value is lost and a circular + true % data element is built. + end}. + +void() -> ok. + +%%-------------------------------------------------------------------- +%% Test to build a tuple in a guard. + +test_tuple_in_guard(T2, T3) -> + %% T2 = {a, b}; T3 = {a, b, c} + ok = if T2 == {element(1, T3), element(2, T3)} -> ok; + true -> other + end, + ok = if T3 == {element(1, T3), element(2, T3), element(3, T3)} -> ok; + true -> other + end, + ok. diff --git a/lib/hipe/test/bs_SUITE_data/bs_add.erl b/lib/hipe/test/bs_SUITE_data/bs_add.erl new file mode 100644 index 0000000000..4b92e6b413 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_add.erl @@ -0,0 +1,26 @@ +%% -*- erlang-indent-level: 2 -*- +%%------------------------------------------------------------------------- +%% The guard in f/3 revealed a problem in the translation of the 'bs_add' +%% BEAM instruction to Icode. The fail label was not properly translated. +%% Fixed 3/2/2011. Then in 2015 we found another issue: g/2. Also fixed. +%%------------------------------------------------------------------------- +-module(bs_add). + +-export([test/0]). + +test() -> + 42 = f(<<12345:16>>, 4711, <<42>>), + true = g(<<1:13>>, 3), %% was handled OK, but + false = g(<<>>, gurka), %% this one leaked badarith + ok. + +f(Bin, A, B) when <<A:9, B:7/binary>> == Bin -> + gazonk; +f(Bin, _, _) when is_binary(Bin) -> + 42. + +%% Complex way of testing (bit_size(Bin) + Len) rem 8 =:= 0 +g(Bin, Len) when is_binary(<<Bin/binary-unit:1, 123:Len>>) -> + true; +g(_, _) -> + false. diff --git a/lib/hipe/test/bs_SUITE_data/bs_bincomp.erl b/lib/hipe/test/bs_SUITE_data/bs_bincomp.erl new file mode 100644 index 0000000000..082b83bab9 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_bincomp.erl @@ -0,0 +1,79 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% File : bs_bincomp.erl +%%% Author : Per Gustafsson <[email protected]> +%%% Purpose : Test bit comprehensions +%%% Created : 13 Sep 2006 +%%%------------------------------------------------------------------- +-module(bs_bincomp). + +-export([test/0]). + +test() -> + ok = byte_aligned(), + ok = bit_aligned(), + ok = extended_byte_aligned(), + ok = extended_bit_aligned(), + ok = mixed(), + ok. + +byte_aligned() -> + <<"abcdefg">> = << <<(X+32)>> || <<X>> <= <<"ABCDEFG">> >>, + <<1:32/little,2:32/little,3:32/little,4:32/little>> = + << <<X:32/little>> || <<X:32>> <= <<1:32,2:32,3:32,4:32>> >>, + <<1:32/little,2:32/little,3:32/little,4:32/little>> = + << <<X:32/little>> || <<X:16>> <= <<1:16,2:16,3:16,4:16>> >>, + ok. + +bit_aligned() -> + <<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>> = + << <<(X+32):7>> || <<X>> <= <<"ABCDEFG">> >>, + <<"ABCDEFG">> = + << <<(X-32)>> || <<X:7>> <= <<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>> >>, + <<1:31/little,2:31/little,3:31/little,4:31/little>> = + << <<X:31/little>> || <<X:31>> <= <<1:31,2:31,3:31,4:31>> >>, + <<1:31/little,2:31/little,3:31/little,4:31/little>> = + << <<X:31/little>> || <<X:15>> <= <<1:15,2:15,3:15,4:15>> >>, + ok. + +extended_byte_aligned() -> + <<"abcdefg">> = << <<(X+32)>> || X <- "ABCDEFG" >>, + "abcdefg" = [(X+32) || <<X>> <= <<"ABCDEFG">>], + <<1:32/little,2:32/little,3:32/little,4:32/little>> = + << <<X:32/little>> || X <- [1,2,3,4] >>, + [256,512,768,1024] = + [X || <<X:16/little>> <= <<1:16,2:16,3:16,4:16>>], + ok. + +extended_bit_aligned() -> + <<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>> = + << <<(X+32):7>> || X <- "ABCDEFG" >>, + "ABCDEFG" = [(X-32) || <<X:7>> <= <<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>>], + <<1:31/little,2:31/little,3:31/little,4:31/little>> = + << <<X:31/little>> || X <- [1,2,3,4] >>, + [256,512,768,1024] = + [X || <<X:15/little>> <= <<1:15,2:15,3:15,4:15>>], + ok. + +mixed() -> + <<2,3,3,4,4,5,5,6>> = + << <<(X+Y)>> || <<X>> <= <<1,2,3,4>>, <<Y>> <= <<1,2>> >>, + <<2,3,3,4,4,5,5,6>> = + << <<(X+Y)>> || <<X>> <= <<1,2,3,4>>, Y <- [1,2] >>, + <<2,3,3,4,4,5,5,6>> = + << <<(X+Y)>> || X <- [1,2,3,4], Y <- [1,2] >>, + [2,3,3,4,4,5,5,6] = + [(X+Y) || <<X>> <= <<1,2,3,4>>, <<Y>> <= <<1,2>>], + [2,3,3,4,4,5,5,6] = + [(X+Y) || <<X>> <= <<1,2,3,4>>, Y <- [1,2]], + <<2:3,3:3,3:3,4:3,4:3,5:3,5:3,6:3>> = + << <<(X+Y):3>> || <<X:3>> <= <<1:3,2:3,3:3,4:3>>, <<Y:3>> <= <<1:3,2:3>> >>, + <<2:3,3:3,3:3,4:3,4:3,5:3,5:3,6:3>> = + << <<(X+Y):3>> || <<X:3>> <= <<1:3,2:3,3:3,4:3>>, Y <- [1,2] >>, + <<2:3,3:3,3:3,4:3,4:3,5:3,5:3,6:3>> = + << <<(X+Y):3>> || X <- [1,2,3,4], Y <- [1,2] >>, + [2,3,3,4,4,5,5,6] = + [(X+Y) || <<X:3>> <= <<1:3,2:3,3:3,4:3>>, <<Y:3>> <= <<1:3,2:3>>], + [2,3,3,4,4,5,5,6] = + [(X+Y) || <<X:3>> <= <<1:3,2:3,3:3,4:3>>, Y <- [1,2]], + ok. diff --git a/lib/hipe/test/bs_SUITE_data/bs_bits.erl b/lib/hipe/test/bs_SUITE_data/bs_bits.erl new file mode 100644 index 0000000000..ef9a6bb137 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_bits.erl @@ -0,0 +1,150 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% File : bs_bits.erl +%%% Author : Per Gustafsson <[email protected]> +%%% Purpose : Tests for bit stream operations including matching, +%%% construction, binary_to_list and list_to_binary +%%% Created : 6 Sep 2006 +%%%------------------------------------------------------------------- +-module(bs_bits). + +-export([test/0]). + +test() -> + <<1:100>> = <<1:100>>, + ok = match(7), + ok = match(9), + ok = match1(15), + ok = match1(31), + ok = horrid_match(), + ok = test_bitstr(), + ok = test_is_bitstr(<<1:1>>,<<8>>), + ok = test_is_binary(<<1:1>>,<<8>>), + ok = test_bitsize(), + ok = asymmetric_tests(), + ok = big_asymmetric_tests(), + ok = bitstr_to_and_from_list(), + ok = big_bitstr_to_and_from_list(), + ok = send_and_receive(), + ok = send_and_receive_alot(), + ok. + +match(N) -> + <<0:N>> = <<0:N>>, + ok. + +match1(N) -> + <<42:N/little>> = <<42:N/little>>, + ok. + +test_is_bitstr(Bitstr, Binary) -> + true = is_bitstring(Bitstr), + true = is_bitstring(Binary), + ok = if is_bitstring(Bitstr) -> ok end, + ok = if is_bitstring(Binary) -> ok end. + +test_is_binary(Bitstr, Binary) -> + false = is_binary(Bitstr), + true = is_binary(Binary), + ok = if is_binary(Bitstr) -> not_ok; true -> ok end, + ok = if is_binary(Binary) -> ok end. + +test_bitsize() -> + 101 = erlang:bit_size(<<1:101>>), + 1001 = erlang:bit_size(<<1:1001>>), + 80 = erlang:bit_size(<<1:80>>), + 800 = erlang:bit_size(<<1:800>>), + Bin = <<0:16#1000000>>, + BigBin = list_to_bitstring([Bin||_ <- lists:seq(1,16#10)]++[<<1:1>>]), + 16#10000001 = bit_size(BigBin), + %% Only run these on computers with lots of memory + %% HugeBin = list_to_bitstring([BigBin||_ <- lists:seq(1,16#10)]++[<<1:1>>]), + %% 16#100000011 = bit_size(HugeBin), + 0 = erlang:bit_size(<<>>), + ok. + +horrid_match() -> + <<1:4,B:24/bitstring>> = <<1:4,42:24/little>>, + <<42:24/little>> = B, + ok. + +test_bitstr() -> + <<1:7,B/bitstring>> = <<1:7,<<1:1,6>>/bitstring>>, + <<1:1,6>> = B, + B = <<1:1,6>>, + ok. + +asymmetric_tests() -> + <<1:12>> = <<0,1:4>>, + <<0,1:4>> = <<1:12>>, + <<1:1,X/bitstring>> = <<128,255,0,0:2>>, + <<1,254,0,0:1>> = X, + X = <<1,254,0,0:1>>, + <<1:1,X1:25/bitstring>> = <<128,255,0,0:2>>, + <<1,254,0,0:1>> = X1, + X1 = <<1,254,0,0:1>>, + ok. + +big_asymmetric_tests() -> + <<1:875,1:12>> = <<1:875,0,1:4>>, + <<1:875,0,1:4>> = <<1:875,1:12>>, + <<1:1,X/bitstring>> = <<128,255,0,0:2,1:875>>, + <<1,254,0,0:1,1:875>> = X, + X = <<1,254,0,0:1,1:875>>, + <<1:1,X1:900/bitstring>> = <<128,255,0,0:2,1:875>>, + <<1,254,0,0:1,1:875>> = X1, + X1 = <<1,254,0,0:1,1:875>>, + ok. + +bitstr_to_and_from_list() -> + <<1:7>> = list_to_bitstring(bitstring_to_list(<<1:7>>)), + <<1,2,3,4,1:1>> = list_to_bitstring(bitstring_to_list(<<1,2,3,4,1:1>>)), + [1,2,3,4,<<1:1>>] = bitstring_to_list(<<1,2,3,4,1:1>>), + <<1:1,1,2,3,4>> = list_to_bitstring([<<1:1>>,1,2,3,4]), + [128,129,1,130,<<0:1>>] = bitstring_to_list(<<1:1,1,2,3,4>>), + ok. + +big_bitstr_to_and_from_list() -> + <<1:800,2,3,4,1:1>> = list_to_bitstring(bitstring_to_list(<<1:800,2,3,4,1:1>>)), + [1,2,3,4|_Rest1] = bitstring_to_list(<<1,2,3,4,1:800,1:1>>), + <<1:801,1,2,3,4>> = list_to_bitstring([<<1:801>>,1,2,3,4]), + ok. + +send_and_receive() -> + Bin = <<1,2:7>>, + Pid = spawn(fun() -> receiver(Bin) end), + Pid ! {self(),<<1:7,8:5,Bin/bitstring>>}, + receive + ok -> + ok + end. + +receiver(Bin) -> + receive + {Pid,<<1:7,8:5,Bin/bitstring>>} -> + Pid ! ok + end. + +send_and_receive_alot() -> + Bin = <<1:1000001>>, + Pid = spawn(fun() -> receiver_alot(Bin) end), + send_alot(100,Bin,Pid). + +send_alot(N,Bin,Pid) when N > 0 -> + Pid ! {self(),<<1:7,8:5,Bin/bitstring>>}, + receive + ok -> + ok + end, + send_alot(N-1,Bin,Pid); +send_alot(0,_Bin,Pid) -> + Pid ! no_more, + ok. + +receiver_alot(Bin) -> + receive + {Pid,<<1:7,8:5,Bin/bitstring>>} -> + Pid ! ok; + no_more -> ok + end, + receiver_alot(Bin). diff --git a/lib/hipe/test/bs_SUITE_data/bs_bitsize.erl b/lib/hipe/test/bs_SUITE_data/bs_bitsize.erl new file mode 100644 index 0000000000..c0774e7279 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_bitsize.erl @@ -0,0 +1,23 @@ +%% -*- erlang-indent-level: 2 -*- +%%------------------------------------------------------------------- +-module(bs_bitsize). + +-export([test/0]). + +test() -> + true = bitsize_in_body(<<1:42>>), + true = bitsize_in_guard(<<1:7>>), + 8 = constant_binary(42), + ok. + +bitsize_in_body(Bin) -> + 42 =:= erlang:bit_size(Bin). + +bitsize_in_guard(Bin) when erlang:bit_size(Bin) rem 7 =:= 0 -> + true; +bitsize_in_guard(Bin) when is_bitstring(Bin) -> + false. + +%% Tests that binary constants can properly be treated in Icode +constant_binary(N) when N > 0 -> + bit_size(<<42>>). diff --git a/lib/hipe/test/bs_SUITE_data/bs_bugs_R08.erl b/lib/hipe/test/bs_SUITE_data/bs_bugs_R08.erl new file mode 100644 index 0000000000..7b62a17cfb --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_bugs_R08.erl @@ -0,0 +1,32 @@ +%% -*- erlang-indent-level: 2 -*- +%%------------------------------------------------------------------- +%% When executing this in R8 (and compiled with R8) the result was +%% {ok,[148,129,0,0]} but should be {ok,[145,148,113,129,0,0,0,0]} +%% Thanks to Kenneth Lundin for sending this to us. +%%------------------------------------------------------------------- + +-module(bs_bugs_R08). + +-export([test/0]). + +test() -> + List = [145,148,113,129,0,0,0,0], + {ok, List} = msisdn_internal_storage(<<145,148,113,129,0,0,0,0>>, []), + ok. + +%% msisdn_internal_storage/3 +%% Convert MSISDN binary to internal datatype (TBCD-octet list) + +msisdn_internal_storage(<<>>, MSISDN) -> + {ok, lists:reverse(MSISDN)}; +msisdn_internal_storage(<<2#11111111:8,_Rest/binary>>, MSISDN) -> + {ok, lists:reverse(MSISDN)}; +msisdn_internal_storage(<<2#1111:4,DigitN:4,_Rest/binary>>, MSISDN) when + DigitN < 10 -> + {ok, lists:reverse([(DigitN bor 2#11110000)|MSISDN])}; +msisdn_internal_storage(<<DigitNplus1:4,DigitN:4,Rest/binary>>, MSISDN) when + DigitNplus1 < 10, DigitN < 10 -> + NewMSISDN = [((DigitNplus1 bsl 4) bor DigitN)|MSISDN], + msisdn_internal_storage(Rest, NewMSISDN); +msisdn_internal_storage(_Rest, _MSISDN) -> + {fault}. %% Mandatory IE incorrect diff --git a/lib/hipe/test/bs_SUITE_data/bs_bugs_R09.erl b/lib/hipe/test/bs_SUITE_data/bs_bugs_R09.erl new file mode 100644 index 0000000000..670f2a08bb --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_bugs_R09.erl @@ -0,0 +1,35 @@ +%% -*- erlang-indent-level: 2 -*- +%%-------------------------------------------------------------------- +%% Date: Mon, 7 Jun 2004 13:07:39 +0300 +%% From: Einar Karttunen +%% To: Erlang ML <[email protected]> +%% Subject: Apparent binary matching bug with native compilation +%% +%% It seems that there is a problem with binary matching when +%% compiling native code. A length prefixed field matches one +%% byte too short in the native case. +%% +%% The test module works when compiled with no options, but +%% crashes with case_clause when compiled with [native]. +%% This has been confirmed with R9C-0 and hipe snapshot 5/4/2004. +%%-------------------------------------------------------------------- + +-module(bs_bugs_R09). + +-export([test/0]). + +test() -> + ["rei",".",[]] = pp(<<3,$r,$e,$i,0>>), + ok. + +pp(Bin) -> + %% io:format("PP with ~p~n", [Bin]), + case Bin of + <<>> -> + ["."]; + <<_:2, Len:6, Part:Len/binary>> -> + [binary_to_list(Part)]; + <<_:2, Len:6, Part:Len/binary, Rest/binary>> -> + %% io:format("Len ~p Part ~p Rest ~p~n", [Len,Part,Rest]), + [binary_to_list(Part), "." | pp(Rest)] + end. diff --git a/lib/hipe/test/bs_SUITE_data/bs_bugs_R12.erl b/lib/hipe/test/bs_SUITE_data/bs_bugs_R12.erl new file mode 100644 index 0000000000..43ee9eb85b --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_bugs_R12.erl @@ -0,0 +1,133 @@ +%% -*- erlang-indent-level: 2 -*- +%%-------------------------------------------------------------------- +%% Contains three cases of bugs that were reported for R12B +%%-------------------------------------------------------------------- +-module(bs_bugs_R12). + +-export([test/0]). + +test() -> + ok = test_beam_bug(), + ok = test_v3_codegen(), + ok = test_hipe_bug(), + ok. + +%%-------------------------------- +%% First test case: a bug in BEAM +%%-------------------------------- +test_beam_bug() -> + lists:foreach(fun (_) -> ok = run(100) end, [1,2,3,4]). + +%% For testing - runs scanner N number of times with same input +run(N) -> + lists:foreach(fun(_) -> scan(<<"region:whatever">>, []) end, lists:seq(1, N)). + +scan(<<>>, TokAcc) -> + lists:reverse(['$thats_all_folks$' | TokAcc]); +scan(<<D, Z, Rest/binary>>, TokAcc) + when (D =:= $D orelse D =:= $d) and + ((Z =:= $\s) or (Z =:= $() or (Z =:= $))) -> + scan(<<Z, Rest/binary>>, ['AND' | TokAcc]); +scan(<<D>>, TokAcc) when (D =:= $D) or (D =:= $d) -> + scan(<<>>, ['AND' | TokAcc]); +scan(<<N, Z, Rest/binary>>, TokAcc) + when (N =:= $N orelse N =:= $n) and + ((Z =:= $\s) or (Z =:= $() or (Z =:= $))) -> + scan(<<Z, Rest/binary>>, ['NOT' | TokAcc]); +scan(<<C, Rest/binary>>, TokAcc) when (C >= $A) and (C =< $Z); + (C >= $a) and (C =< $z); + (C >= $0) and (C =< $9) -> + case Rest of + <<$:, R/binary>> -> + scan(R, [{'FIELD', C} | TokAcc]); + _ -> + scan(Rest, [{'KEYWORD', C} | TokAcc]) + end. + +%%--------------------------------------------------- +%% Second test case: an internal error in v3_codegen +%% Reported by Mateusz Berezecki on 19/1/2008 +%%--------------------------------------------------- +-define(S, {42, 4242, 4711}). +-define(R, <<90,164,116>>). + +test_v3_codegen() -> + _ = random:seed(?S), + B0 = gen_bit(120, <<>>), + B1 = set_bit(B0, 5), + B2 = clr_bit(B1, 5), + ?R = set_bit(B2, 5), + ok. + +gen_bit(0, Acc) -> Acc; +gen_bit(N, Acc) when is_integer(N), N > 0 -> + gen_bit(N-1, <<Acc/bits, (random:uniform(2)-1):1>>). + +%% sets bit K in the Bitmap +set_bit(<<_Start:32/unsigned-little-integer, Bitmap/bits>>, K) + when is_integer(K), 0 < K, K =< bit_size(Bitmap) -> + Before = K-1, + After = bit_size(Bitmap) - K, + <<BeforeBits:Before/bits, _:1, AfterBits:After/bits>> = Bitmap, + <<BeforeBits/bits, 1:1, AfterBits/bits>>. + +%% clears bit K in the Bitmap +clr_bit(<<_Start:32/unsigned-little-integer, Bitmap/bits>>, K) + when is_integer(K), 0 < K, K =< bit_size(Bitmap) -> + Before = K-1, + After = bit_size(Bitmap) - K, + <<BeforeBits:Before/bits, _:1, AfterBits:After/bits>> = Bitmap, + <<BeforeBits/bits, 0:1, AfterBits/bits>>. + +%%-------------------------------------------------------------------- +%% Third test case: a bug in HiPE +%% Reported by Steve Vinoski on 1/3/2008 +%% +%% Below find the results of compiling and running the example code at +%% the bottom of this message. Using "c" to compile gives the right +%% answer; using "hipe:c" gives the wrong answer. This is with R12B-1. +%% +%% Within the code, on the second instance of function check/2 you'll +%% find a commented-out guard. If you uncomment the guard, then the +%% code works correctly with both "c" and "hipe:c". +%%--------------------------------------------------------------------- + +test_hipe_bug() -> + String = "2006/10/02/Linux-Journal", + Binary = list_to_binary(String), + StringToMatch = "200x/" ++ String ++ " ", + BinaryToMatch = list_to_binary(StringToMatch), + {ok, Binary} = match(BinaryToMatch), + ok. + +match(<<>>) -> + nomatch; +match(Bin) -> + <<Front:16/binary, Tail/binary>> = Bin, + case Front of + <<_:3/binary,"x/",Y:4/binary,$/,M:2/binary,$/,D:2/binary,$/>> -> + case check(Tail) of + {ok, Match} -> + {ok, <<Y/binary,$/,M/binary,$/,D/binary,$/,Match/binary>>}; + {nomatch, Skip} -> + {skip, Skip+size(Front)}; + _ -> + wrong_answer + end; + _ -> + nomatch + end. + +check(Bin) -> + check(Bin, 0). +check(<<$ , _/binary>>, 0) -> + {nomatch, 0}; +check(Bin, Len) -> %when Len < size(Bin) -> + case Bin of + <<Front:Len/binary, $ , _/binary>> -> + {ok, Front}; + <<_:Len/binary, $., _/binary>> -> + {nomatch, Len}; + _ -> + check(Bin, Len+1) + end. diff --git a/lib/hipe/test/bs_SUITE_data/bs_build.erl b/lib/hipe/test/bs_SUITE_data/bs_build.erl new file mode 100644 index 0000000000..256cea9403 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_build.erl @@ -0,0 +1,41 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% File : bs_build.erl +%%% Author : Per Gustafsson <[email protected]> +%%% Purpose : +%%% +%%% Created : 12 Sep 2007 +%%%------------------------------------------------------------------- +-module(bs_build). + +-export([test/0]). + +test() -> + <<0,1,2,3,4,5,6>> = Bin = << <<X>> || X <- lists:seq(0, 6)>>, + test(Bin). + +test(Bin) -> + <<0,1,2,3,4,5,6,0,1,2,3,4,5,6>> = RealBin = multiply(Bin, 2), + <<6,5,4,3,2,1,0,6,5,4,3,2,1,0>> = reverse(RealBin), + RealBin = copy(RealBin), + RealBin = bc(RealBin), + ok. + +multiply(Bin, 1) -> + Bin; +multiply(Bin, N) when N > 0 -> + <<(multiply(Bin, N-1))/binary, Bin/binary>>. + +bc(Bin) -> + << <<X>> || <<X>> <= Bin >>. + +reverse(<<X, Rest/binary>>) -> + <<(reverse(Rest))/binary, X>>; +reverse(<<>>) -> <<>>. + +copy(Bin) -> + copy(Bin, <<>>). + +copy(<<X, Rest/binary>>, Bin) -> + copy(Rest, <<Bin/binary, X>>); +copy(<<>>, Bin) -> Bin. diff --git a/lib/hipe/test/bs_SUITE_data/bs_catch_bug.erl b/lib/hipe/test/bs_SUITE_data/bs_catch_bug.erl new file mode 100644 index 0000000000..6125f8f87f --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_catch_bug.erl @@ -0,0 +1,25 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% File : bs_catch_bug.erl +%%% Author : Per Gustafsson <[email protected]> +%%% Purpose : Tests a catch-related bug which might destroy properties +%%% of ICode CFGs which are assumed by the subsequent ICode +%%% binary pass. +%%% Created : 22 Jan 2004 +%%% ------------------------------------------------------------------- +-module(bs_catch_bug). + +-export([test/0]). + +test() -> + test(foo, <<>>). + +%% Introduced auxiliary test/2 function so that constant propagation +%% does not destroy the properties of the test. - Kostis 26/1/2004 +test(X, Bin) -> + catch (<<_/binary>> = X), + X = case Bin of + <<42,_/binary>> -> weird_bs_match; + _ -> X + end, + ok. diff --git a/lib/hipe/test/bs_SUITE_data/bs_checksum.erl b/lib/hipe/test/bs_SUITE_data/bs_checksum.erl new file mode 100644 index 0000000000..ca4f254f12 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_checksum.erl @@ -0,0 +1,35 @@ +%% -*- erlang-indent-level: 2 -*- +%%-------------------------------------------------------------------- +%% Code from Zoltan Toth that crashed the HiPE compiler (in R11B-3). +%% The problem was that the binary matching produces a pretty large +%% integer and we tried to find the range for this integer in a bad way. +%% Fixed on the same day -- 6th March 2007. +%%-------------------------------------------------------------------- + +-module(bs_checksum). + +-export([test/0]). + +test() -> + "3389DAE361AF79B04C9C8E7057F60CC6" = checksum(<<42>>), + ok. + +checksum(Bin) -> + Context = erlang:md5_init(), + checksum(Context, Bin). + +checksum(Context, <<>>) -> + bin_to_hex(erlang:md5_final(Context)); +checksum(Context, <<Bin:20480/binary,Rest/binary>>) -> + checksum(erlang:md5_update(Context, Bin), Rest); +checksum(Context,Bin) -> + checksum(erlang:md5_update(Context, Bin), <<>>). + +bin_to_hex(Bin) -> + lists:flatten([byte_to_hex(X) || X <- binary_to_list(Bin)]). + +byte_to_hex(Byte) -> + [int_to_hex(Byte div 16), int_to_hex(Byte rem 16)]. + +int_to_hex(Int) when Int < 10 -> $0 + Int; +int_to_hex(Int) when Int > 9 -> $A + Int - 10. diff --git a/lib/hipe/test/bs_SUITE_data/bs_construct.erl b/lib/hipe/test/bs_SUITE_data/bs_construct.erl new file mode 100644 index 0000000000..b9e7d93570 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_construct.erl @@ -0,0 +1,305 @@ +%% -*- erlang-indent-level: 2 -*- +%%-------------------------------------------------------------------- +%% Tests that basic cases of binary construction work +%%-------------------------------------------------------------------- +-module(bs_construct). + +-export([test/0]). + +test() -> + <<42>> = sz(8), + <<42:8/little>> = sz_little(8), + <<55>> = take_five(1, 3, 1, 7, 4), + ok = bs5(), + 16#10000008 = bit_size(large_bin(1, 2, 3, 4)), + ok = bad_ones(), + ok = zero_width(), + ok = not_used(), + ok = bad_append(), + ok = system_limit(), + ok = bad_floats(), + ok = huge_binaries(), + ok. + +%%-------------------------------------------------------------------- +%% Taken from a bug report submitted by Dan Wallin (24 Oct 2003), the +%% following cases test construction of binaries whose segments have +%% sizes that are statically unknown. + +sz(S) -> + <<42:S>>. + +sz_little(S) -> + <<42:S/little>>. + +take_five(A, Head, FB, C, Tail) -> + <<A:Head, FB:1, C:Tail>>. + +%%-------------------------------------------------------------------- + +bs5() -> + Const = mk_constant(), + Pairs = mk_pairs(), + true = are_same(Const, Pairs), + true = lists:all(fun ({B, L}) -> binary_to_list(B) =:= L end, Pairs), + ok. + +are_same(C, L) -> + C =:= L. + +mk_constant() -> + [{<<213>>,[213]}, + {<<56>>,[56]}, + {<<1,2>>,[1,2]}, + {<<71>>,[71]}, + {<<8,1>>,[8,1]}, + {<<3,9>>,[3,9]}, + {<<9,3>>,[9,3]}, + {<<0,0,0,0>>,[0,0,0,0]}, + {<<62,0,0,0>>,[62,0,0,0]}, + {<<0,0,0,62>>,[0,0,0,62]}, + {<<138,99,0,147>>,[138,99,0,147]}, + {<<138,99,0,148>>,[138,99,0,148]}, + {<<147,0,99,138>>,[147,0,99,138]}, + {<<255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255>>, + [255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255,255]}, + {<<13>>,[13]}, + {<<0,4,0,5>>,[0,4,0,5]}, + {<<129>>,[129]}, + {<<129>>,[129]}, + {<<1,2>>,[1,2]}, + {<<1>>,[1]}, + {<<4,3,1>>,[4,3,1]}, + {<<47>>,[47]}, + {<<>>,[]}, + {<<97,112,97>>,[97,112,97]}, + {<<46,110,142,77,45,204,233>>,[46,110,142,77,45,204,233]}, + {<<>>,[]}]. + +mk_pairs() -> + L4 = [138,99,0,147], + [{<<-43>>,[256-43]}, + {<<56>>,[56]}, + {<<1,2>>,[1,2]}, + {<<4:4,7:4>>,[4*16+7]}, + {<<1:5,1:11>>,[1*8,1]}, + {<<777:16/big>>,[3,9]}, + {<<777:16/little>>,[9,3]}, + {<<0.0:32/float>>,[0,0,0,0]}, + {<<0.125:32/float>>,[62,0,0,0]}, + {<<0.125:32/little-float>>,[0,0,0,62]}, + {<<57285702734876389752897683:32>>,L4}, + {<<57285702734876389752897684:32>>,[138,99,0,148]}, + {<<57285702734876389752897683:32/little>>,lists:reverse(L4)}, + {<<-1:17/unit:8>>,lists:duplicate(17,255)}, + {<<13>>,[13]}, + {<<4:8/unit:2,5:2/unit:8>>,[0,4,0,5]}, + {<<1:1,0:6,1:1>>,[129]}, + {<<1:1/little,0:6/little,1:1/little>>,[129]}, + {<<<<1,2>>/binary>>,[1,2]}, + {<<<<1,2>>:1/binary>>,[1]}, + {<<4,3,<<1,2>>:1/binary>>,[4,3,1]}, + {<<(256*45+47)>>,[47]}, + {<<57:0>>,[]}, + {<<"apa">>,"apa"}, + {<<1:3,"string",9:5>>,[46,110,142,77,45,204,233]}, + {<<>>,[]}]. + +%%-------------------------------------------------------------------- +%% Constructs a big enough binary to have a bit size that needs a +%% bignum on 32-bit architectures + +large_bin(X1, X2, X3, X4) -> + Sz = 16#4000000, + <<1, <<X1:Sz, X2:Sz, X3:Sz, X4:Sz>>/bits>>. + +%%-------------------------------------------------------------------- +%% Test construction of "bad" binaries + +-define(FAIL(Expr), {'EXIT', {badarg, _}} = (catch Expr)). + +bad_ones() -> + PI = math:pi(), + ?FAIL(<<PI>>), + Bin12 = <<1,2>>, + ?FAIL(<<Bin12>>), + E = 2.71, + ?FAIL(<<E/binary>>), + Int = 24334, + ?FAIL(<<Int/binary>>), + BigInt = 24334344294788947129487129487219847, + ?FAIL(<<BigInt/binary>>), + Bin123 = <<1,2,3>>, + ?FAIL(<<Bin123/float>>), + ok. + +%%-------------------------------------------------------------------- +%% Taken from the emulator bs_construct_SUITE - seg faulted till 18.1 + +zero_width() -> + Z = id(0), + Small = id(42), + Big = id(1 bsl 128), % puts stuff on the heap + <<>> = <<Small:Z>>, + <<>> = <<Small:0>>, + <<>> = <<Big:Z>>, + <<>> = <<Big:0>>, + ok. + +id(X) -> X. + +%%-------------------------------------------------------------------- +%% Taken from bs_construct_SUITE. The test checks that constructed +%% binaries that are not used would still give a `badarg' exception. +%% Problem was that in native code one of them gave `badarith'. + +not_used() -> + ok = not_used1(3, <<"dum">>), + {'EXIT',{badarg,_}} = (catch not_used1(42, "dum_string")), + {'EXIT',{badarg,_}} = (catch not_used2(666, -2)), + {'EXIT',{badarg,_}} = (catch not_used2(666, "bad_size")), % this one + {'EXIT',{badarg,_}} = (catch not_used3(666)), + ok. + +not_used1(I, BinString) -> + <<I:32,BinString/binary>>, + ok. + +not_used2(I, Sz) -> + <<I:Sz>>, + ok. + +not_used3(I) -> + <<I:(-8)>>, + ok. + +%%-------------------------------------------------------------------- +%% Taken from bs_construct_SUITE. + +bad_append() -> + do_bad_append(<<127:1>>, fun append_unit_3/1), + do_bad_append(<<127:2>>, fun append_unit_3/1), + do_bad_append(<<127:17>>, fun append_unit_3/1), + + do_bad_append(<<127:3>>, fun append_unit_4/1), + do_bad_append(<<127:5>>, fun append_unit_4/1), + do_bad_append(<<127:7>>, fun append_unit_4/1), + do_bad_append(<<127:199>>, fun append_unit_4/1), + + do_bad_append(<<127:7>>, fun append_unit_8/1), + do_bad_append(<<127:9>>, fun append_unit_8/1), + + do_bad_append(<<0:8>>, fun append_unit_16/1), + do_bad_append(<<0:15>>, fun append_unit_16/1), + do_bad_append(<<0:17>>, fun append_unit_16/1), + ok. + +do_bad_append(Bin0, Appender) -> + {'EXIT',{badarg,_}} = (catch Appender(Bin0)), + + Bin1 = id(<<0:3,Bin0/bitstring>>), + <<_:3,Bin2/bitstring>> = Bin1, + {'EXIT',{badarg,_}} = (catch Appender(Bin2)), + + %% Create a writable binary. + Empty = id(<<>>), + Bin3 = <<Empty/bitstring,Bin0/bitstring>>, + {'EXIT',{badarg,_}} = (catch Appender(Bin3)), + ok. + +append_unit_3(Bin) -> + <<Bin/binary-unit:3,0:1>>. + +append_unit_4(Bin) -> + <<Bin/binary-unit:4,0:1>>. + +append_unit_8(Bin) -> + <<Bin/binary,0:1>>. + +append_unit_16(Bin) -> + <<Bin/binary-unit:16,0:1>>. + +%%-------------------------------------------------------------------- +%% Taken from bs_construct_SUITE. + +system_limit() -> + WordSize = erlang:system_info(wordsize), + BitsPerWord = WordSize * 8, + {'EXIT',{system_limit,_}} = + (catch <<0:(id(0)),42:(id(1 bsl BitsPerWord))>>), + {'EXIT',{system_limit,_}} = + (catch <<42:(id(1 bsl BitsPerWord)),0:(id(0))>>), + {'EXIT',{system_limit,_}} = + (catch <<(id(<<>>))/binary,0:(id(1 bsl 100))>>), + + %% Would fail to load. + {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 67)>>), + {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 64)+1)>>), + case WordSize of + 4 -> + system_limit_32(); + 8 -> + ok + end. + +system_limit_32() -> + {'EXIT',{badarg,_}} = (catch <<42:(-1)>>), + {'EXIT',{badarg,_}} = (catch <<42:(id(-1))>>), + {'EXIT',{badarg,_}} = (catch <<42:(id(-389739873536870912))/unit:8>>), + {'EXIT',{system_limit,_}} = (catch <<42:536870912/unit:8>>), + {'EXIT',{system_limit,_}} = (catch <<42:(id(536870912))/unit:8>>), + {'EXIT',{system_limit,_}} = (catch <<0:(id(8)),42:536870912/unit:8>>), + {'EXIT',{system_limit,_}} = (catch <<0:(id(8)),42:(id(536870912))/unit:8>>), + + %% The size would be silently truncated, resulting in a crash. + {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 35)>>), + {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 32)+1)>>), + + %% Would fail to load. + {'EXIT',{system_limit,_}} = (catch <<0:(1 bsl 43)>>), + {'EXIT',{system_limit,_}} = (catch <<0:((1 bsl 40)+1)>>), + ok. + +%%-------------------------------------------------------------------- + +bad_floats() -> + WordSize = erlang:system_info(wordsize), + BitsPerWord = WordSize * 8, + {'EXIT',{badarg,_}} = (catch <<3.14:(id(33))/float>>), + {'EXIT',{badarg,_}} = (catch <<3.14:(id(64 bor 32))/float>>), + {'EXIT',{badarg,_}} = (catch <<3.14:(id((1 bsl 28) bor 32))/float>>), + {'EXIT',{system_limit,_}} = (catch <<3.14:(id(1 bsl BitsPerWord))/float>>), + ok. + +%%-------------------------------------------------------------------- +%% A bug in the implementation of binaries compared sizes in bits with sizes in +%% bytes, causing <<0:(id((1 bsl 31)-1))>> to fail to construct with +%% 'system_limit'. +%% <<0:(id((1 bsl 32)-1))>> was succeeding because the comparison was +%% (incorrectly) signed. + +huge_binaries() -> + AlmostIllegal = id(<<0:(id((1 bsl 32)-8))>>), + case erlang:system_info(wordsize) of + 4 -> huge_binaries_32(AlmostIllegal); + 8 -> ok + end, + garbage_collect(), + id(<<0:(id((1 bsl 31)-1))>>), + id(<<0:(id((1 bsl 30)-1))>>), + garbage_collect(), + ok. + +huge_binaries_32(AlmostIllegal) -> + %% Attempt construction of too large binary using bs_init/1 (which takes the + %% number of bytes as an argument, which should be compared to the maximum + %% size in bytes). + {'EXIT',{system_limit,_}} = (catch <<0:32,AlmostIllegal/binary>>), + %% Attempt construction of too large binary using bs_init/1 with a size in + %% bytes that has the msb set (and would be negative if it was signed). + {'EXIT',{system_limit,_}} = + (catch <<0:8, AlmostIllegal/binary, AlmostIllegal/binary, + AlmostIllegal/binary, AlmostIllegal/binary, + AlmostIllegal/binary, AlmostIllegal/binary, + AlmostIllegal/binary, AlmostIllegal/binary>>), + ok. diff --git a/lib/hipe/test/bs_SUITE_data/bs_decode.erl b/lib/hipe/test/bs_SUITE_data/bs_decode.erl new file mode 100644 index 0000000000..d12654a1e3 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_decode.erl @@ -0,0 +1,980 @@ +%% -*- erlang-indent-level: 2 -*- + +-module(bs_decode). + +-export([test/0]). + +-include("bs_decode_extract.hrl"). + +-define(PDU, <<30,16,0,90,0,1,0,0,255,255,255,255,81,67,101,7,0,0,0,96, + 6,12,146,18,14,0,15,252,16,0,0,17,0,0,128,0,2,241,33,131, + 0,20,7,97,112,110,48,49,51,97,8,101,114,105,99,115,115, + 111,110,2,115,101,132,0,20,128,192,35,16,1,5,0,16,5,117, + 115,101,114,53,5,112,97,115,115,53,133,0,4,172,28,12,1, + 133,0,4,172,28,12,3,134,0,8,145,148,113,129,0,0,0,0>>). + +-define(RES, {ok,{sesT_createReqV0, + {mvsgT_tid,{mvsgT_imsi,<<81,67,101,7,0,0,0,240>>},6}, + [81,67,101,7,0,0,0,96], + {sesT_qualityOfServiceV0,1,4,9,2,18}, + 0,subscribed,0,0, + {mvsgT_pdpAddressType,ietf_ipv4,[]}, + [<<"apn013a">>,<<"ericsson">>,<<"se">>], + {masT_protocolConfigOptions,[], + {masT_pap,true,1,5,"user5","pass5"}, + []}, + {mvsgT_ipAddress,ipv4,172,28,12,1,0,0,0,0}, + {mvsgT_ipAddress,ipv4,172,28,12,3,0,0,0,0}, + {mvsT_msisdn,<<145,148,113,129,0,0,0,0>>}}, + 1}). + +test() -> + ?RES = decode_v0_opt(42, ?PDU), + ok. + +decode_v0_opt(0, Pdu) -> + decode_gtpc_msg(Pdu); +decode_v0_opt(N, Pdu) -> + decode_gtpc_msg(Pdu), + decode_v0_opt(N-1, Pdu). + +%%% -------------------------------------------------------------- +%%% #3.1.2 DECODE GTP-C MESSAGE +%%% -------------------------------------------------------------- + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% Function : decode_gtpc_msg(GTP_C_Message)-> +%%% {ok,Request,ControlDataUs} | +%%% {fault,Cause,Request,ControlDataUs} +%%% +%%% Types : GTP_C_Message = binary(), GTP-C message from SGSN +%%% Request = record(), Containing decoded request +%%% ControlDataUS = record(), Containing header info +%%% Cause = integer(), Error code +%%% +%%% Description: This function decodes a binary GTP-C message and +%%% stores it in a record. Different records are used +%%% for different message types. +%%% +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + +%%% Create PDP Context Request +%%% GTP97, SNN=0 +%%% (No SNDCP N-PDU number) +decode_gtpc_msg(<<0:3,_:4,0:1,16:8,_Length:16,SequenceNumber:16, + _FlowLabel:16,_SNDCP_N_PDU_Number:8,_:3/binary-unit:8, + TID:8/binary-unit:8,InformationElements/binary>>) -> + Errors = #protocolErrors{}, + {ok,TID2} = tid_internal_storage(TID,[]), + EmptyCreateReq = #sesT_createReqV0{tid = TID2, + tidRaw = binary_to_list(TID)}, + case catch decode_ie_create(InformationElements,0,Errors,EmptyCreateReq) of + {ok,CreateReq} -> + {ok,CreateReq,SequenceNumber}; + {fault,Cause,CreateReq} -> + {fault,Cause,CreateReq,SequenceNumber}; + {'EXIT',_Reason} -> + {fault,193,EmptyCreateReq,SequenceNumber} + end; + +%%% Update PDP Context Request +%%% GTP97, SNN=0 +%%% (No SNDCP N-PDU number) +decode_gtpc_msg(<<0:3,_:4,0:1,18:8,_Length:16,SequenceNumber:16, + _FlowLabel:16,_SNDCP_N_PDU_Number:8,_:3/binary-unit:8, + TID:8/binary-unit:8,InformationElements/binary>>) -> + io:format("hej", []), + Errors = #protocolErrors{}, + {ok,TID2}=tid_internal_storage(TID,[]), + EmptyUpdateReq=#sesT_updateReqV0{tid=TID2, + tidRaw=binary_to_list(TID)}, + case catch decode_ie_update(InformationElements,0,Errors, + EmptyUpdateReq) of + {ok,UpdateReq} -> + {ok,UpdateReq,SequenceNumber}; + {fault,Cause,UpdateReq} -> + {fault,Cause,UpdateReq,SequenceNumber}; + {'EXIT',Reason} -> + io:format("hej", []), + {fault,193,EmptyUpdateReq,SequenceNumber, Reason} + end; + +%%% Delete PDP Context Request +%%% GTP97, SNN=0 +%%% (No SNDCP N-PDU number) +decode_gtpc_msg(<<0:3,_:4,0:1,20:8,_Length:16,SequenceNumber:16, + _FlowLabel:16,_SNDCP_N_PDU_Number:8,_:3/binary-unit:8, + TID:8/binary-unit:8,_InformationElements/binary>>) -> + {ok,TID2} = tid_internal_storage(TID,[]), + DeleteReq = #sesT_deleteReqV0{tid=TID2}, + {ok,DeleteReq,SequenceNumber}; + +%%% Delete PDP Context Response +%%% GTP97, SNN=0 +%%% (No SNDCP N-PDU number) +decode_gtpc_msg(<<0:3,_:4,0:1,21:8,_Length:16,SequenceNumber:16, + _FlowLabel:16,_SNDCP_N_PDU_Number:8,_:3/binary-unit:8, + TID:8/binary-unit:8,InformationElements/binary>>) -> + {ok,TID2} = tid_internal_storage(TID,[]), + EmptyDeleteRes = #sesT_deleteResV0{tid=TID2}, + case catch decode_ie_delete_res(InformationElements,0,EmptyDeleteRes) of + {ok, DeleteRes} -> + {ok,DeleteRes,SequenceNumber}; + {fault,Cause,DeleteRes} -> + {fault,Cause,DeleteRes,SequenceNumber}; + {'EXIT',_Reason} -> + {fault,193,EmptyDeleteRes,SequenceNumber} + end; + +%%% Error handling +decode_gtpc_msg(_GTP_C_Message) -> + {fault}. + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% decode_ie_create/4 +%%% Decode information elements for Create PDP Context Request + +%%% All elements decoded +decode_ie_create(<<>>,PresentIEs,Errors,CreateReq) -> + %% Check mandatory IE's + if + (PresentIEs band 16#77D) =/= 16#77D -> + {fault,202,CreateReq}; %Mandatory IE missing + true -> %OK + %% Check errors during decoding + case Errors of + #protocolErrors{invalidManIE=true} -> %Invalid mandatory IE + {fault,201,CreateReq}; %Mandatory IE incorrect + #protocolErrors{outOfSequence=true} -> %Out of sequence + {fault,193,CreateReq}; %Invalid message format + #protocolErrors{incorrectOptIE=true} -> %Incorrect optional IE + {fault,203,CreateReq}; %Optional IE incorrect + _ -> %OK + {ok,CreateReq} + end + end; + +%%% Quality of Service Profile, Mandatory +decode_ie_create(<<6:8,QoSElement:3/binary-unit:8,Rest/binary>>,PresentIEs, + Errors,CreateReq) -> + if + (PresentIEs band 16#00000001) =:= 16#00000001 -> %Repeated IE's, ignore + decode_ie_create(Rest,PresentIEs,Errors,CreateReq); + PresentIEs > 16#00000001 -> %Out of sequence + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + <<_:2,DelayClass:3,ReliabilityClass:3, + PeakThroughput:4,_:1,PrecedenceClass:3, + _:3,MeanThroughput:5>> = QoSElement, + QoS=#sesT_qualityOfServiceV0{delayClass=DelayClass, + reliabilityClass=ReliabilityClass, + peakThroughput=PeakThroughput, + precedenceClass=PrecedenceClass, + meanThroughput=MeanThroughput}, + UpdatedCreateReq=CreateReq#sesT_createReqV0{qos=QoS}, + decode_ie_create(Rest,(PresentIEs bor 16#00000001), + UpdatedErrors,UpdatedCreateReq); + true -> %OK + <<_:2,DelayClass:3,ReliabilityClass:3, + PeakThroughput:4,_:1,PrecedenceClass:3, + _:3,MeanThroughput:5>> = QoSElement, + QoS=#sesT_qualityOfServiceV0{delayClass=DelayClass, + reliabilityClass=ReliabilityClass, + peakThroughput=PeakThroughput, + precedenceClass=PrecedenceClass, + meanThroughput=MeanThroughput}, + UpdatedCreateReq=CreateReq#sesT_createReqV0{qos=QoS}, + decode_ie_create(Rest,(PresentIEs bor 16#00000001), + Errors,UpdatedCreateReq) + end; + +%%% Recovery, Optional +decode_ie_create(<<14:8,Recovery:8,Rest/binary>>, + PresentIEs,Errors,CreateReq) -> + if + (PresentIEs band 16#00000002) =:= 16#00000002 -> %Repeated IE, ignored + decode_ie_create(Rest,PresentIEs,Errors,CreateReq); + PresentIEs > 16#00000002 -> %Out of sequence + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedCreateReq=CreateReq#sesT_createReqV0{recovery=Recovery}, + decode_ie_create(Rest,(PresentIEs bor 16#00000002), + UpdatedErrors,UpdatedCreateReq); + true -> %OK + UpdatedCreateReq=CreateReq#sesT_createReqV0{recovery=Recovery}, + decode_ie_create(Rest,(PresentIEs bor 16#00000002),Errors, + UpdatedCreateReq) + end; + +%%% Selection mode, Mandatory +decode_ie_create(<<15:8,_:6,SelectionMode:2,Rest/binary>>,PresentIEs, + Errors,CreateReq) -> + if + (PresentIEs band 16#00000004) =:= 16#00000004 -> %Repeated IE, ignored + decode_ie_create(Rest,PresentIEs,Errors,CreateReq); + PresentIEs > 16#00000004 -> %Out of sequence + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedCreateReq=CreateReq#sesT_createReqV0{ + selMode=selection_mode_internal_storage(SelectionMode)}, + decode_ie_create(Rest,(PresentIEs bor 16#00000004), + UpdatedErrors,UpdatedCreateReq); + true -> %OK + UpdatedCreateReq=CreateReq#sesT_createReqV0{ + selMode=selection_mode_internal_storage(SelectionMode)}, + decode_ie_create(Rest,(PresentIEs bor 16#00000004),Errors, + UpdatedCreateReq) + end; + +%%% Flow Label Data I, Mandatory +decode_ie_create(<<16:8,FlowLabel:16,Rest/binary>>,PresentIEs,Errors,CreateReq) -> + if + (PresentIEs band 16#00000008) =:= 16#00000008 -> %Repeated IE, ignored + decode_ie_create(Rest,PresentIEs,Errors,CreateReq); + PresentIEs > 16#00000008 -> %Out of sequence + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedCreateReq=CreateReq#sesT_createReqV0{flowLblData=FlowLabel}, + decode_ie_create(Rest,(PresentIEs bor 16#00000008), + UpdatedErrors,UpdatedCreateReq); + true -> %OK + UpdatedCreateReq=CreateReq#sesT_createReqV0{flowLblData=FlowLabel}, + decode_ie_create(Rest,(PresentIEs bor 16#00000008),Errors, + UpdatedCreateReq) + end; + +%%% Flow Label Signalling, Mandatory +decode_ie_create(<<17:8,FlowLabel:16,Rest/binary>>,PresentIEs,Errors,CreateReq) -> + if + (PresentIEs band 16#00000010) =:= 16#00000010 -> %Repeated IE, ignored + decode_ie_create(Rest,PresentIEs,Errors,CreateReq); + PresentIEs > 16#00000010 -> %Out of sequence + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedCreateReq=CreateReq#sesT_createReqV0{flowLblSig=FlowLabel}, + decode_ie_create(Rest,(PresentIEs bor 16#00000010), + UpdatedErrors,UpdatedCreateReq); + true -> %OK + UpdatedCreateReq=CreateReq#sesT_createReqV0{flowLblSig=FlowLabel}, + decode_ie_create(Rest,(PresentIEs bor 16#00000010),Errors, + UpdatedCreateReq) + end; + +%%% End User Address, Mandatory +decode_ie_create(<<128:8,Length:16,More/binary>>,PresentIEs, + Errors,CreateReq) -> + <<PDPElement:Length/binary-unit:8,Rest/binary>> = More, + if + (PresentIEs band 16#00000020) =:= 16#00000020 -> %Repeated IE, ignore + decode_ie_create(Rest,PresentIEs,Errors,CreateReq); + PresentIEs > 16#00000020 -> %Out of sequence + case pdp_addr_internal_storage(PDPElement) of + {ok,PDPAddress} -> + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedCreateReq=CreateReq#sesT_createReqV0{endUserAdd=PDPAddress}, + decode_ie_create(Rest,(PresentIEs bor 16#00000020), + UpdatedErrors,UpdatedCreateReq); + {fault} -> + UpdatedErrors=Errors#protocolErrors{invalidManIE=true, + outOfSequence=true}, + decode_ie_create(Rest,(PresentIEs bor 16#00000020), + UpdatedErrors,CreateReq) + end; + true -> %OK + case pdp_addr_internal_storage(PDPElement) of + {ok,PDPAddress} -> + UpdatedCreateReq=CreateReq#sesT_createReqV0{endUserAdd=PDPAddress}, + decode_ie_create(Rest,(PresentIEs bor 16#00000020), + Errors,UpdatedCreateReq); + {fault} -> + UpdatedErrors=Errors#protocolErrors{invalidManIE=true}, + decode_ie_create(Rest,(PresentIEs bor 16#00000020), + UpdatedErrors,CreateReq) + end + end; + +%%% Access Point Name, Mandatory +decode_ie_create(<<131:8,Length:16,More/binary>>,PresentIEs, + Errors,CreateReq) -> + <<APNElement:Length/binary-unit:8,Rest/binary>> = More, + if + (PresentIEs band 16#00000040) =:= 16#00000040 -> %Repeated IE, ignore + decode_ie_create(Rest,PresentIEs,Errors,CreateReq); + PresentIEs > 16#00000040 -> %Out of sequence + case catch apn_internal_storage(APNElement,[]) of + {ok,APN} -> + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedCreateReq=CreateReq#sesT_createReqV0{accPointName=APN}, + decode_ie_create(Rest,(PresentIEs bor 16#00000040), + UpdatedErrors,UpdatedCreateReq); + _ -> + UpdatedErrors=Errors#protocolErrors{outOfSequence=true, + invalidManIE=true}, + decode_ie_create(Rest,(PresentIEs bor 16#00000040), + UpdatedErrors,CreateReq) + end; + true -> %OK + case catch apn_internal_storage(APNElement,[]) of + {ok,APN} -> + UpdatedCreateReq=CreateReq#sesT_createReqV0{accPointName=APN}, + decode_ie_create(Rest,(PresentIEs bor 16#00000040), + Errors,UpdatedCreateReq); + _ -> + UpdatedErrors=Errors#protocolErrors{invalidManIE=true}, + decode_ie_create(Rest,(PresentIEs bor 16#00000040), + UpdatedErrors,CreateReq) + end + end; + +%%% Protocol Configuration Options, Optional +decode_ie_create(<<132:8,Length:16,More/binary>>,PresentIEs,Errors,CreateReq) -> + <<ConfigurationElement:Length/binary-unit:8,Rest/binary>> = More, + if + (PresentIEs band 16#00000080) =:= 16#00000080 -> %Repeated IE, ignore + decode_ie_create(Rest,PresentIEs,Errors,CreateReq); + PresentIEs > 16#00000080 -> %Out of sequence + case catch pco_internal_storage(ConfigurationElement) of + {ok,PCO} -> + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedCreateReq=CreateReq#sesT_createReqV0{protConOpt=PCO}, + decode_ie_create(Rest,(PresentIEs bor 16#00000080), + UpdatedErrors,UpdatedCreateReq); + _ -> + UpdatedErrors=Errors#protocolErrors{outOfSequence=true, + incorrectOptIE=true}, + decode_ie_create(Rest,(PresentIEs bor 16#00000080), + UpdatedErrors,CreateReq) + end; + true -> %OK + case catch pco_internal_storage(ConfigurationElement) of + {ok,PCO} -> + UpdatedCreateReq=CreateReq#sesT_createReqV0{protConOpt=PCO}, + decode_ie_create(Rest,(PresentIEs bor 16#00000080), + Errors,UpdatedCreateReq); + _ -> + UpdatedErrors=Errors#protocolErrors{incorrectOptIE=true}, + decode_ie_create(Rest,(PresentIEs bor 16#00000080), + UpdatedErrors,CreateReq) + end + end; + +%%% SGSN Address for signalling, Mandatory OR SGSN Address for user traffic, Mandatory +decode_ie_create(<<133:8,Length:16,More/binary>>,PresentIEs, + Errors,CreateReq) -> + <<AddressElement:Length/binary-unit:8,Rest/binary>> = More, + if + (PresentIEs band 16#00000300) =:= 16#00000300 -> %Repeated IE, ignore + decode_ie_create(Rest,PresentIEs,Errors,CreateReq); + PresentIEs > 16#00000200 -> %Out of sequence + if + (PresentIEs band 16#00000100) =:= 16#00000000 -> %Signalling + case gsn_addr_internal_storage(AddressElement) of + {ok,GSNAddr} -> + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedCreateReq=CreateReq#sesT_createReqV0{sgsnAddSig=GSNAddr}, + decode_ie_create(Rest,(PresentIEs bor 16#00000100), + UpdatedErrors,UpdatedCreateReq); + {fault} -> + UpdatedErrors=Errors#protocolErrors{invalidManIE=true, + outOfSequence=true}, + decode_ie_create(Rest,(PresentIEs bor 16#00000100), + UpdatedErrors,CreateReq) + end; + true -> % User traffic + case gsn_addr_internal_storage(AddressElement) of + {ok,GSNAddr} -> + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedCreateReq=CreateReq#sesT_createReqV0{sgsnAddUser=GSNAddr}, + decode_ie_create(Rest,(PresentIEs bor 16#00000200), + UpdatedErrors,UpdatedCreateReq); + {fault} -> + UpdatedErrors=Errors#protocolErrors{invalidManIE=true, + outOfSequence=true}, + decode_ie_create(Rest,(PresentIEs bor 16#00000200), + UpdatedErrors,CreateReq) + end + end; + PresentIEs < 16#00000100 -> %OK, SGSN Address for signalling + case gsn_addr_internal_storage(AddressElement) of + {ok,GSNAddr} -> + UpdatedCreateReq=CreateReq#sesT_createReqV0{sgsnAddSig=GSNAddr}, + decode_ie_create(Rest,(PresentIEs bor 16#00000100), + Errors,UpdatedCreateReq); + {fault} -> + UpdatedErrors=Errors#protocolErrors{invalidManIE=true}, + decode_ie_create(Rest,(PresentIEs bor 16#00000100), + UpdatedErrors,CreateReq) + end; + true -> %OK, SGSN Address for user traffic + case gsn_addr_internal_storage(AddressElement) of + {ok,GSNAddr} -> + UpdatedCreateReq=CreateReq#sesT_createReqV0{sgsnAddUser=GSNAddr}, + decode_ie_create(Rest,(PresentIEs bor 16#00000200), + Errors,UpdatedCreateReq); + {fault} -> + UpdatedErrors=Errors#protocolErrors{invalidManIE=true}, + decode_ie_create(Rest,(PresentIEs bor 16#00000200), + UpdatedErrors,CreateReq) + end + end; + +%%% MSISDN, Mandatory +decode_ie_create(<<134:8,Length:16,More/binary>>,PresentIEs, + Errors,CreateReq) -> + <<MSISDNElement:Length/binary-unit:8,Rest/binary>> = More, + if + (PresentIEs band 16#00000400) =:= 16#00000400 -> %Repeated IE, ignore + decode_ie_create(Rest,PresentIEs,Errors,CreateReq); + PresentIEs > 16#00000400 -> %Out of sequence + case msisdn_internal_storage(MSISDNElement,[]) of + {ok,MSISDN} -> + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedCreateReq=CreateReq#sesT_createReqV0{msisdn=MSISDN}, + decode_ie_create(Rest,(PresentIEs bor 16#00000400), + UpdatedErrors,UpdatedCreateReq); + {fault} -> + UpdatedErrors=Errors#protocolErrors{outOfSequence=true,invalidManIE=true}, + decode_ie_create(Rest,(PresentIEs bor 16#00000400), + UpdatedErrors,CreateReq) + end; + true -> %OK + UpdatedCreateReq=CreateReq#sesT_createReqV0{msisdn=#mvsT_msisdn{value=MSISDNElement}}, + decode_ie_create(Rest,(PresentIEs bor 16#00000400), + Errors,UpdatedCreateReq) + + end; + +%%% Private Extension, Optional +%%% Not implemented + +%%% Error handling, Unexpected or unknown IE +decode_ie_create(UnexpectedIE,PresentIEs,Errors,CreateReq) -> + case check_ie(UnexpectedIE) of + {defined_ie,Rest} -> %OK, ignored + decode_ie_create(Rest,PresentIEs,Errors,CreateReq); + {handled_ie,Rest} -> %OK, ignored + decode_ie_create(Rest,PresentIEs,Errors,CreateReq); + {unhandled_ie} -> %Error, abort decoding + {fault,193,CreateReq} %Invalid message format + end. + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% decode_ie_update/4 +%%% Decode information elements for Update PDP Context Request + +%%% All elements decoded +decode_ie_update(<<>>,PresentIEs,Errors,UpdateReq) -> + %% Check mandatory IE's + if + (PresentIEs band 16#3D) =/= 16#3D -> + {fault,202,UpdateReq}; %Mandatory IE missing + true -> %OK + %% Check errors during decoding + case Errors of + #protocolErrors{invalidManIE=true} -> %Invalid mandatory IE + {fault,201,UpdateReq}; %Mandatory IE incorrect + #protocolErrors{outOfSequence=true} -> %Out of sequence + {fault,193,UpdateReq}; %Invalid message format + _ -> %OK + {ok,UpdateReq} + end + end; + +%%% Quality of Service Profile, Mandatory +decode_ie_update(<<6:8,QoSElement:3/binary-unit:8,Rest/binary>>,PresentIEs, + Errors,UpdateReq) -> + if + (PresentIEs band 16#00000001) =:= 16#00000001 -> %Repeated IE's, ignore + decode_ie_update(Rest,PresentIEs,Errors,UpdateReq); + PresentIEs > 16#00000001 -> %Out of sequence + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + <<_:2,DelayClass:3,ReliabilityClass:3, + PeakThroughput:4,_:1,PrecedenceClass:3, + _:3,MeanThroughput:5>> = QoSElement, + QoS=#sesT_qualityOfServiceV0{delayClass=DelayClass, + reliabilityClass=ReliabilityClass, + peakThroughput=PeakThroughput, + precedenceClass=PrecedenceClass, + meanThroughput=MeanThroughput}, + UpdatedUpdateReq=UpdateReq#sesT_updateReqV0{qos=QoS}, + decode_ie_update(Rest,(PresentIEs bor 16#00000001), + UpdatedErrors,UpdatedUpdateReq); + true -> %OK + <<_:2,DelayClass:3,ReliabilityClass:3, + PeakThroughput:4,_:1,PrecedenceClass:3, + _:3,MeanThroughput:5>> = QoSElement, + QoS=#sesT_qualityOfServiceV0{delayClass=DelayClass, + reliabilityClass=ReliabilityClass, + peakThroughput=PeakThroughput, + precedenceClass=PrecedenceClass, + meanThroughput=MeanThroughput}, + UpdatedUpdateReq=UpdateReq#sesT_updateReqV0{qos=QoS}, + decode_ie_update(Rest,(PresentIEs bor 16#00000001), + Errors,UpdatedUpdateReq) + end; + +%%% Recovery, Optional +decode_ie_update(<<14:8,Recovery:8,Rest/binary>>,PresentIEs,Errors,UpdateReq) -> + if + (PresentIEs band 16#00000002) =:= 16#00000002 -> %Repeated IE, ignored + decode_ie_update(Rest,PresentIEs,Errors,UpdateReq); + PresentIEs > 16#00000002 -> %Out of sequence + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedUpdateReq=UpdateReq#sesT_updateReqV0{recovery=Recovery}, + decode_ie_update(Rest,(PresentIEs bor 16#00000002), + UpdatedErrors,UpdatedUpdateReq); + true -> %OK + UpdatedUpdateReq=UpdateReq#sesT_updateReqV0{recovery=Recovery}, + decode_ie_update(Rest,(PresentIEs bor 16#00000002),Errors, + UpdatedUpdateReq) + end; + +%%% Flow Label Data I, Mandatory +decode_ie_update(<<16:8,FlowLabel:16,Rest/binary>>,PresentIEs,Errors,UpdateReq) -> + if + (PresentIEs band 16#00000004) =:= 16#00000004 -> %Repeated IE, ignored + decode_ie_update(Rest,PresentIEs,Errors,UpdateReq); + PresentIEs > 16#00000004 -> %Out of sequence + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedUpdateReq=UpdateReq#sesT_updateReqV0{flowLblData=FlowLabel}, + decode_ie_update(Rest,(PresentIEs bor 16#00000004), + UpdatedErrors,UpdatedUpdateReq); + true -> %OK + UpdatedUpdateReq=UpdateReq#sesT_updateReqV0{flowLblData=FlowLabel}, + decode_ie_update(Rest,(PresentIEs bor 16#00000004),Errors, + UpdatedUpdateReq) + end; + +%%% Flow Label Signalling, Mandatory +decode_ie_update(<<17:8,FlowLabel:16,Rest/binary>>,PresentIEs,Errors,UpdateReq) -> + if + (PresentIEs band 16#00000008) =:= 16#00000008 -> %Repeated IE, ignored + decode_ie_update(Rest,PresentIEs,Errors,UpdateReq); + PresentIEs > 16#00000008 -> %Out of sequence + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedUpdateReq=UpdateReq#sesT_updateReqV0{flowLblSig=FlowLabel}, + decode_ie_update(Rest,(PresentIEs bor 16#00000008), + UpdatedErrors,UpdatedUpdateReq); + true -> %OK + UpdatedUpdateReq=UpdateReq#sesT_updateReqV0{flowLblSig=FlowLabel}, + decode_ie_update(Rest,(PresentIEs bor 16#00000008),Errors, + UpdatedUpdateReq) + end; + +%%% SGSN Address for signalling, Mandatory OR SGSN Address for user traffic, Mandatory +decode_ie_update(<<133:8,Length:16,More/binary>>,PresentIEs, + Errors,UpdateReq) -> + <<AddressElement:Length/binary-unit:8,Rest/binary>> = More, + if + (PresentIEs band 16#00000030) =:= 16#00000030 -> %Repeated IE, ignore + decode_ie_update(Rest,PresentIEs,Errors,UpdateReq); + PresentIEs > 16#00000020 -> %Out of sequence + if + (PresentIEs band 16#00000010) =:= 16#00000000 -> %Signalling + case gsn_addr_internal_storage(AddressElement) of + {ok,GSNAddr} -> + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedUpdateReq=UpdateReq#sesT_updateReqV0{sgsnAddSig=GSNAddr}, + decode_ie_update(Rest,(PresentIEs bor 16#00000010), + UpdatedErrors,UpdatedUpdateReq); + {fault} -> + UpdatedErrors=Errors#protocolErrors{invalidManIE=true, + outOfSequence=true}, + decode_ie_update(Rest,(PresentIEs bor 16#00000010), + UpdatedErrors,UpdateReq) + end; + true -> % User traffic + case gsn_addr_internal_storage(AddressElement) of + {ok,GSNAddr} -> + UpdatedErrors=Errors#protocolErrors{outOfSequence=true}, + UpdatedUpdateReq=UpdateReq#sesT_updateReqV0{sgsnAddUser=GSNAddr}, + decode_ie_update(Rest,(PresentIEs bor 16#00000020), + UpdatedErrors,UpdatedUpdateReq); + {fault} -> + UpdatedErrors=Errors#protocolErrors{invalidManIE=true, + outOfSequence=true}, + decode_ie_update(Rest,(PresentIEs bor 16#00000020), + UpdatedErrors,UpdateReq) + end + end; + PresentIEs < 16#00000010 -> %OK, SGSN Address for signalling + case gsn_addr_internal_storage(AddressElement) of + {ok,GSNAddr} -> + UpdatedUpdateReq=UpdateReq#sesT_updateReqV0{sgsnAddSig=GSNAddr}, + decode_ie_update(Rest,(PresentIEs bor 16#00000010), + Errors,UpdatedUpdateReq); + {fault} -> + UpdatedErrors=Errors#protocolErrors{invalidManIE=true}, + decode_ie_update(Rest,(PresentIEs bor 16#00000010), + UpdatedErrors,UpdateReq) + end; + true -> %OK, SGSN Address for user traffic + case gsn_addr_internal_storage(AddressElement) of + {ok,GSNAddr} -> + UpdatedUpdateReq=UpdateReq#sesT_updateReqV0{sgsnAddUser=GSNAddr}, + decode_ie_update(Rest,(PresentIEs bor 16#00000020), + Errors,UpdatedUpdateReq); + {fault} -> + UpdatedErrors=Errors#protocolErrors{invalidManIE=true}, + decode_ie_update(Rest,(PresentIEs bor 16#00000020), + UpdatedErrors,UpdateReq) + end + end; + +%%% Private Extension, Optional +%%% Not implemented + +%%% Error handling, Unexpected or unknown IE +decode_ie_update(UnexpectedIE,PresentIEs,Errors,UpdateReq) -> + case check_ie(UnexpectedIE) of + {defined_ie,Rest} -> %OK, ignored + decode_ie_update(Rest,PresentIEs,Errors,UpdateReq); + {handled_ie,Rest} -> %OK, ignored + decode_ie_update(Rest,PresentIEs,Errors,UpdateReq); + {unhandled_ie} -> %Error, abort decoding + {fault,193,UpdateReq} %Invalid message format + end. + + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% decode_ie_delete_req/4 +%%% Decode information elements for Delete PDP Context Request + +%%% Private Extension, Optional +%%% Not implemented + + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% decode_ie_delete_res/4 +%%% Decode information elements for Delete PDP Context Response + +%%% All elements decoded +decode_ie_delete_res(<<>>,PresentIEs,DeleteRes) -> + %% Check mandatory IE's + if + (PresentIEs band 16#0001) =/= 16#0001 -> + {fault,202,DeleteRes}; %Mandatory IE missing + true -> %OK + {ok,DeleteRes} + end; + +%%% Cause, Mandatory +decode_ie_delete_res(<<1:8,Cause:8,Rest/binary>>,PresentIEs,DeleteRes) -> + if + (PresentIEs band 16#00000001) =:= 16#00000001 -> %Repeated IE, ignored + decode_ie_delete_res(Rest,PresentIEs,DeleteRes); + true -> %OK + UpdatedDeleteRes=DeleteRes#sesT_deleteResV0{cause=Cause}, + decode_ie_delete_res(Rest,(PresentIEs bor 16#00000001), + UpdatedDeleteRes) + end; + +%%% Private Extension, Optional +%%% Not implemented + +%%% Error handling, Unexpected or unknown IE +decode_ie_delete_res(UnexpectedIE,PresentIEs,DeleteRes) -> + case check_ie(UnexpectedIE) of + {defined_ie,Rest} -> %OK, ignored + decode_ie_delete_res(Rest,PresentIEs,DeleteRes); + {handled_ie,Rest} -> %OK, ignored + decode_ie_delete_res(Rest,PresentIEs,DeleteRes); + {unhandled_ie} -> %Error, abort decoding + {fault,193,DeleteRes} %Invalid message format + end. + +%%% -------------------------------------------------------------- +%%% #3.2 COMMON INTERNAL FUNCTIONS +%%% -------------------------------------------------------------- + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% check_ie/1 +%%% Check Information Element, Unexpected or Unknown +check_ie(<<1:8,_:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% IMSI +check_ie(<<2:8,_:8/binary-unit:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% RAI +check_ie(<<3:8,_:6/binary-unit:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% TTLI +check_ie(<<4:8,_:4/binary-unit:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% P-TMSI +check_ie(<<5:8,_:4/binary-unit:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% Quality of Service Profile +check_ie(<<6:8,_:3/binary-unit:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% Reordering Required +check_ie(<<8:8,_:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% Authentication Triplet +check_ie(<<9:8,_:28/binary-unit:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% MAP Cause +check_ie(<<11:8,_:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% P-TMSI Signature +check_ie(<<12:8,_:3/binary-unit:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% MS Validated +check_ie(<<13:8,_:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% Recovery +check_ie(<<14:8,_:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% Selection Mode +check_ie(<<15:8,_:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% Flow Label Data I +check_ie(<<16:8,_:16,Rest/binary>>) -> + {defined_ie,Rest}; +%%% Flow Label Signalling +check_ie(<<17:8,_:16,Rest/binary>>) -> + {defined_ie,Rest}; +%%% Flow Label Data II +check_ie(<<18:8,_:32,Rest/binary>>) -> + {defined_ie,Rest}; +%%% MS Not Reachable Reason +check_ie(<<19:8,_:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% Charging ID +check_ie(<<127:8,_:4/binary-unit:8,Rest/binary>>) -> + {defined_ie,Rest}; +%%% TLV element, skipped using Length +check_ie(<<1:1,_:7,Length:16,More/binary>>) -> + if + Length > byte_size(More) -> + {unhandled_ie}; + true -> + <<_:Length/binary-unit:8,Rest/binary>> = More, + {handled_ie,Rest} + end; +%%% TV element, unknown size. Can not be handled. +check_ie(_UnhandledIE) -> + {unhandled_ie}. + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% tid_internal_storage/3 +%%% Convert TID binary to internal datatype +tid_internal_storage(Bin,_) -> + Size = byte_size(Bin) - 1, + <<Front:Size/binary,NSAPI:4,DigitN:4>> = Bin, + Result = + case DigitN of + 2#1111 -> + #mvsgT_tid{imsi = #mvsgT_imsi{value = Front}, nsapi = NSAPI}; + _ -> + Value = <<Front/binary,2#1111:4,DigitN:4>>, + #mvsgT_tid{imsi = #mvsgT_imsi{value = Value}, nsapi = NSAPI} + end, + {ok,Result}. +%% tid_internal_storage(<<NSAPI:4,2#1111:4>>,IMSI) -> +%% {ok,#mvsgT_tid{imsi=#mvsgT_imsi{value=lists:reverse(IMSI)}, +%% nsapi=NSAPI}}; +%% tid_internal_storage(<<NSAPI:4,DigitN:4>>,IMSI) when +%% DigitN < 10 -> +%% {ok,#mvsgT_tid{imsi=#mvsgT_imsi{value=lists:reverse([(DigitN bor 2#11110000)|IMSI])}, +%% nsapi=NSAPI}}; +%% tid_internal_storage(<<2#11111111:8,Rest/binary>>,IMSI) -> +%% tid_internal_storage(Rest,IMSI); +%% tid_internal_storage(<<2#1111:4,DigitN:4,Rest/binary>>,IMSI) when +%% DigitN < 10 -> +%% tid_internal_storage(Rest,[(DigitN bor 2#11110000)|IMSI]); +%% tid_internal_storage(<<DigitNplus1:4,DigitN:4,Rest/binary>>,IMSI) when +%% DigitNplus1 < 10, +%% DigitN < 10 -> +%% tid_internal_storage(Rest,[((DigitNplus1 bsl 4) bor DigitN)|IMSI]); +%% tid_internal_storage(_Rest,_IMSI) -> +%% {fault}. %% Mandatory IE incorrect + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% selection_mode_internal_storage/1 +%%% Convert Selection Mode integer to internal datatype (enum) +selection_mode_internal_storage(0) -> + subscribed; +selection_mode_internal_storage(1) -> + msRequested; +selection_mode_internal_storage(2) -> + sgsnSelected; +selection_mode_internal_storage(3) -> + sgsnSelected. + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% pdp_addr_internal_storage/1 +%%% Convert PDP address to internal datatype (record containing +%%% addresstype and value) +pdp_addr_internal_storage(<<_:4,0:4,1:8>>) -> + {ok,#mvsgT_pdpAddressType{pdpTypeNbr=etsi_ppp,address=[]}}; +pdp_addr_internal_storage(<<_:4,0:4,2:8>>) -> + {ok,#mvsgT_pdpAddressType{pdpTypeNbr=etsi_osp_ihoss,address=[]}}; +pdp_addr_internal_storage(<<_:4,1:4,16#21:8>>) -> + {ok,#mvsgT_pdpAddressType{pdpTypeNbr=ietf_ipv4,address=[]}}; +pdp_addr_internal_storage(<<_:4,1:4,16#21:8,IP_A:8,IP_B:8,IP_C:8,IP_D:8>>) -> + {ok,#mvsgT_pdpAddressType{pdpTypeNbr=ietf_ipv4, + address=[IP_A,IP_B,IP_C,IP_D]}}; +pdp_addr_internal_storage(<<_:4,1:4,16#57:8,IP_A:16,IP_B:16,IP_C:16,IP_D:16, + IP_E:16,IP_F:16,IP_G:16,IP_H:16>>) -> + {ok,#mvsgT_pdpAddressType{pdpTypeNbr=ietf_ipv6, + address=[IP_A,IP_B,IP_C,IP_D,IP_E,IP_F,IP_G,IP_H]}}; +pdp_addr_internal_storage(_PDP_ADDR) -> + {fault}. + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% apn_internal_storage/2 +%%% Convert APN to internal datatype (List containing APN labels) +apn_internal_storage(<<>>,APN) -> + {ok,lists:reverse(APN)}; +apn_internal_storage(<<Length:8,Rest/binary>>,APN) -> + <<Label:Length/binary-unit:8,MoreAPNLabels/binary>> = Rest, + apn_internal_storage(MoreAPNLabels,[Label|APN]). + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% pco_internal_storage/1 +%%% Convert Protocol Configuration Options to internal datatype. +%%% Implemented configuration options: +%%% For PPP: +%%% LCP - Not implemented +%%% PAP - Authenticate request +%%% CHAP - Challenge +%%% - Response +%%% IPCP - IP-Address +%%% For OSP:IHOSS +%%% Nothing implemented +pco_internal_storage(<<1:1,_:4,0:3,PPPConfigurationOptions/binary>>) -> + case ppp_configuration_options(PPPConfigurationOptions, + #masT_pap{exists=false},[],[]) of + {ok,PAP,CHAP,IPCP} -> + {ok,#masT_protocolConfigOptions{pap=PAP,chap=CHAP,ipcp=IPCP}}; + {fault} -> + {fault} + end; +pco_internal_storage(<<1:1,_:4,1:3,_OSP_IHOSSConfigurationOptions/binary>>) -> + {ok,osp_ihoss}; +pco_internal_storage(_UnknownConfigurationOptions) -> + {fault}. %% Optional IE incorrect + +ppp_configuration_options(<<>>,PAP,CHAP,IPCP) -> + {ok,PAP,CHAP,IPCP}; +ppp_configuration_options(<<16#C021:16,Length:8,More/binary>>,PAP,CHAP,IPCP) -> + %% LCP - Not implemented + <<_LCP:Length/binary-unit:8,Rest/binary>> = More, + ppp_configuration_options(Rest,PAP,CHAP,IPCP); +ppp_configuration_options(<<16#C023:16,_Length:8,1:8,Identifier:8,DataLength:16, + More/binary>>,_PAP,CHAP,IPCP) -> + %% PAP - Authenticate request + ActualDataLength=DataLength-4, %% DataLength includes Code, Identifier and itself + <<Data:ActualDataLength/binary-unit:8,Rest/binary>> = More, + <<PeerIDLength:8,PeerData/binary>> = Data, + <<PeerID:PeerIDLength/binary-unit:8,PasswdLength:8,PasswordData/binary>> = PeerData, + <<Password:PasswdLength/binary,_Padding/binary>> = PasswordData, + ppp_configuration_options(Rest,#masT_pap{exists=true,code=1,id=Identifier, + username=binary_to_list(PeerID), + password=binary_to_list(Password)},CHAP,IPCP); + +ppp_configuration_options(<<16#C023:16,Length:8,More/binary>>,PAP,CHAP,IPCP) -> + %% PAP - Other, not implemented + <<_PAP:Length/binary-unit:8,Rest/binary>> = More, + ppp_configuration_options(Rest,PAP,CHAP,IPCP); +ppp_configuration_options(<<16#C223:16,_Length:8,1:8,Identifier:8,DataLength:16, + More/binary>>,PAP,CHAP,IPCP) -> + %% CHAP - Challenge + ActualDataLength=DataLength-4, %% DataLength includes Code, Identifier and itself + <<Data:ActualDataLength/binary-unit:8,Rest/binary>> = More, + <<ValueSize:8,ValueAndName/binary>> = Data, + <<Value:ValueSize/binary-unit:8,Name/binary>> = ValueAndName, + ppp_configuration_options(Rest,PAP,[#masT_chap{code=1,id=Identifier, + value=binary_to_list(Value), + name=binary_to_list(Name)}|CHAP], + IPCP); +ppp_configuration_options(<<16#C223:16,_Length:8,2:8,Identifier:8,DataLength:16, + More/binary>>,PAP,CHAP,IPCP) -> + %% CHAP - Response + ActualDataLength=DataLength-4, %% DataLength includes Code, Identifier and itself + <<Data:ActualDataLength/binary-unit:8,Rest/binary>> = More, + <<ValueSize:8,ValueAndName/binary>> = Data, + <<Value:ValueSize/binary-unit:8,Name/binary>> = ValueAndName, + ppp_configuration_options(Rest,PAP,[#masT_chap{code=2,id=Identifier, + value=binary_to_list(Value), + name=binary_to_list(Name)}|CHAP], + IPCP); +ppp_configuration_options(<<16#C223:16,Length:8,More/binary>>,PAP,CHAP,IPCP) -> + %% CHAP - Other, not implemented + <<_CHAP:Length/binary-unit:8,Rest/binary>> = More, + ppp_configuration_options(Rest,PAP,CHAP,IPCP); +ppp_configuration_options(<<16#8021:16,_Length:8,1:8,Identifier:8,OptionsLength:16, + More/binary>>,PAP,CHAP,IPCP) -> + %% IPCP - Configure request + ActualOptionsLength=OptionsLength-4, %% OptionsLength includes Code, Identifier and itself + <<Options:ActualOptionsLength/binary-unit:8,Rest/binary>> = More, + case Options of + <<3:8,6:8,A1:8,A2:8,A3:8,A4:8>> -> + %% IP Address, version 4 + ppp_configuration_options(Rest,PAP,CHAP, + [#masT_ipcp{exists=true,code=1, + id=Identifier, + ipcpList=[#masT_ipcpData{type=3,ipAddress= + #mvsgT_ipAddress{version=ipv4, + a1=A1,a2=A2, + a3=A3,a4=A4, + a5=0,a6=0, + a7=0,a8=0}, + rawMessage=binary_to_list(Options)}]}|IPCP]); + <<129:8,6:8,B1:8,B2:8,B3:8,B4:8>> -> + %% IP Address, version 4 + ppp_configuration_options(Rest,PAP,CHAP, + [#masT_ipcp{exists=true,code=1, + id=Identifier, + ipcpList=[#masT_ipcpData{type=129,ipAddress= + #mvsgT_ipAddress{version=ipv4, + a1=B1,a2=B2, + a3=B3,a4=B4}, + rawMessage=binary_to_list(Options)}]}|IPCP]); + + <<131:8,6:8,C1:8,C2:8,C3:8,C4:8>> -> + %% IP Address, version 4 + ppp_configuration_options(Rest,PAP,CHAP, + [#masT_ipcp{exists=true,code=1, + id=Identifier, + ipcpList=[#masT_ipcpData{type=131,ipAddress= + #mvsgT_ipAddress{version=ipv4, + a1=C1,a2=C2, + a3=C3,a4=C4}, + rawMessage=binary_to_list(Options)}]}|IPCP]); + _ -> + ppp_configuration_options(Rest,PAP,CHAP,IPCP) + end; +ppp_configuration_options(<<_UnknownProtocolID:16,Length:8,More/binary>>, + PAP,CHAP,IPCP) -> + <<_Skipped:Length/binary-unit:8,Rest/binary>> = More, + ppp_configuration_options(Rest,PAP,CHAP,IPCP); +ppp_configuration_options(_Unhandled,_PAP,_CHAP,_IPCP) -> + {fault}. + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% gsn_addr_internal_storage/1 +%%% Convert GSN Address to internal datatype +gsn_addr_internal_storage(<<IP_A:8,IP_B:8,IP_C:8,IP_D:8>>) -> + {ok,#mvsgT_ipAddress{version=ipv4,a1=IP_A,a2=IP_B,a3=IP_C,a4=IP_D,a5=0,a6=0,a7=0,a8=0}}; +gsn_addr_internal_storage(<<IP_A:16,IP_B:16,IP_C:16,IP_D:16, + IP_E:16,IP_F:16,IP_G:16,IP_H:16>>) -> + {ok,#mvsgT_ipAddress{version=ipv6,a1=IP_A,a2=IP_B,a3=IP_C,a4=IP_D, + a5=IP_E,a6=IP_F,a7=IP_G,a8=IP_H}}; +gsn_addr_internal_storage(_GSN_ADDR) -> + {fault}. + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% msisdn_internal_storage/3 +%%% Convert MSISDN binary to internal datatype (TBCD-octet list) + +msisdn_internal_storage(<<>>,MSISDN) -> + {ok,#mvsT_msisdn{value=lists:reverse(MSISDN)}}; +msisdn_internal_storage(<<2#11111111:8,_Rest/binary>>,MSISDN) -> + {ok,#mvsT_msisdn{value=lists:reverse(MSISDN)}}; +msisdn_internal_storage(<<2#1111:4,DigitN:4,_Rest/binary>>,MSISDN) when + DigitN < 10 -> + {ok,#mvsT_msisdn{value=lists:reverse([(DigitN bor 2#11110000)|MSISDN])}}; +msisdn_internal_storage(<<DigitNplus1:4,DigitN:4,Rest/binary>>,MSISDN) when + DigitNplus1 < 10, + DigitN < 10 -> + NewMSISDN=[((DigitNplus1 bsl 4) bor DigitN)|MSISDN], + msisdn_internal_storage(Rest,NewMSISDN); +msisdn_internal_storage(_Rest,_MSISDN) -> + {fault}. %% Mandatory IE incorrect diff --git a/lib/hipe/test/bs_SUITE_data/bs_decode_extract.hrl b/lib/hipe/test/bs_SUITE_data/bs_decode_extract.hrl new file mode 100644 index 0000000000..80add514a0 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_decode_extract.hrl @@ -0,0 +1,91 @@ +-ifndef(EXTDEC_HRL). +-define(EXTDEC_HRL, true). + +-record(protocolErrors,{ + invalidManIE=false, + outOfSequence=false, + incorrectOptIE=false}). +-record(mvsT_msisdn, {value}). +-record(mvsT_isdnAddress, {value}). +-record(mvsT_hlrAddress, {value}). +-record(mvsT_authenticationTriplet, {rand, sres, kc}). +-record(mvsT_authenticationQuintuplet, {rand, xres, ck, ik, autn}). +-record(mvsT_resynchInfo, {rand, auts}). +-record(mvsT_resynch, {label, value}). +-record(mvsT_storeImsiFault, {label, value}). +-record(mvsT_additionalImsisResults, {roamingStatus, defaultApnOperatorId, misc1, misc2, misc3}). +-record(mvsT_pdpActiveRecord, {contextId, nsapi, pdpTypeReq, pdpAddrReq, apnReq, qosReq, pdpTypeInUse, pdpAddressNature, pdpAddressInUse, apnInUse, ggsnAddrInUse, qosNegotiated}). +-record(mvsgT_rai, {mcc, mnc, lac, rac}). +-record(mvsgT_lai, {mcc, mnc, lac}). +-record(mvsgT_errorInd, {dummyElement}). +-record(mvsgT_deleteRes, {cause}). +-record(mvsgT_deleteReq, {dummyElement}). +-record(mvsgT_ptmsi, {value}). +-record(mvsgT_ddRef, {cid, extId, validity}). +-record(mvsgT_dpRef, {cid, devId}). +-record(mvsgT_qualityOfService, {delayClass, relClass, peakThrput, precClass, meanThrput}). +-record(mvsgT_pdpAddressType, {pdpTypeNbr, address}). +-record(mvsgT_msNetworkCapability, {gea1, smCapDediccatedChannel, smCapGprsChannel, ucs2Support, ssScreenInd}). +-record(mvsgT_cellId, {mcc, mnc, lac, rac, ci}). +-record(mvsgT_ipAddress, {version, a1, a2, a3, a4, a5, a6, a7, a8}). +-record(mvsgT_restartContextData, {gsn_address, restart_counter}). +-record(mvsgT_updateRes, {cause, qos, ggsnAddSig, ggsnAddUser, recovery, flowLabDataI, flowLabSig, chargId, optFlags}). +-record(mvsgT_updateReq, {qos, sgsnAddSig, sgsnAddUser, recovery, flowLabDataI, flowLabSig, otpFlags}). +-record(mvsgT_imsi, {value}). +-record(mvsgT_tid, {imsi, nsapi}). +-record(mvsgT_extQualityOfService, {allocRetention, trfClass, delOrder, delOfErrSDU, maxSDUSize, maxBRUp, maxBRDown, residualBER, sduErrorRatio, transferDelay, traffHandlPrio, guarBRUp, guarBRDown}). +-record(mvsgT_qualServ, {label, value}). +-record(sesT_gnDevContextData, {numberOfContext, recoveryInfoArray}). +-record(sesT_tid, {imsi, nsapi}). +-record(sesT_gnDevContextDataInfo, {dummy}). +-record(sesT_teid, {value}). +-record(sesT_qualityOfServiceV1, {allocRetPriority, delayClass, reliabilityClass, peakThroughput, precedenceClass, meanThroughput, trafficClass, deliveryOrder, delivOfErrSDU, maxSDUsize, maxBrUp, maxBrDown, residualBER, sduErrorRatio, transferDelay, trafficHandlPrio, guaranteedBrUp, guaranteedBrDown}). +-record(sesT_flowLbl, {value}). +-record(sesT_qualityOfServiceV0, {delayClass, reliabilityClass, peakThroughput, precedenceClass, meanThroughput}). +-record(sesT_createReq, {dummy}). +-record(sesT_createRes, {dummy}). +-record(sesT_deleteReq, {dummy}). +-record(sesT_deleteRes, {dummy}). +-record(sesT_gtid, {imsi, nsapi}). +-record(sesT_updateReq, {dummy}). +-record(sesT_updateRes, {dummy}). +-record(sesT_gcontrolDataUs, {gtpSeqNr, gsnAddress, gtunnelId, gsnPort}). +-record(sesT_gcontrolDataDs, {gtpSeqNr, gsnAddress, protocol, gtunnelId, flowLabSig, gsnPort}). +-record(sesT_createResV1, {cause, teidSignalling, teidData, ggsnAddSig, ggsnAddUser, reorderingReq, recovery, chargId, endUserAdd, optFlags, protConOpt, qos}). +-record(sesT_createReqV1, {qos, sgsnAddSig, sgsnAddUser, selMode, recovery, msisdn, endUserAdd, accPointName, optFlags, protConOpt, imsi, teidData, teidSignalling, nsapi}). +-record(sesT_deleteReqV1, {teardownInd, nsapi}). +-record(sesT_deleteResV1, {cause}). +-record(sesT_updateReqV1, {imsi, recovery, teidData, teidSignalling, nsapi, sgsnAddSig, sgsnAddUser, qos}). +-record(sesT_updateResV1, {cause, recovery, teidData, teidSignalling, chargId, ggsnAddSig, ggsnAddUser, qos}). +-record(sesT_deleteReqV0, {tid}). +-record(sesT_deleteResV0, {tid, cause}). +-record(sesT_createReqV0, {tid, tidRaw, qos, recovery, selMode, flowLblData, flowLblSig, endUserAdd, accPointName, protConOpt, sgsnAddSig, sgsnAddUser, msisdn}). +-record(sesT_createResV0, {tid, cause, qos, reorderingReq, recovery, flowLblData, flowLblSig, chargId, endUserAdd, protConOpt, ggsnAddSig, ggsnAddUser}). +-record(sesT_updateReqV0, {tid, tidRaw, qos, recovery, flowLblData, flowLblSig, sgsnAddSig, sgsnAddUser}). +-record(sesT_updateResV0, {tid, cause, qos, recovery, flowLblData, flowLblSig, chargId, ggsnAddSig, ggsnAddUser}). +-record(sesT_echoReq, {dummy}). +-record(sesT_echoRes, {dummy}). +-record(sesT_echoReqV1, {dummy}). +-record(sesT_echoResV1, {recovery}). +-record(sesT_echoReqV0, {dummy}). +-record(sesT_echoResV0, {recovery}). +-record(masT_apnSecurity, {sgsnSel, subscribedSel, userSel, ipSpoofing}). +-record(masT_radiusServer, {radiusApn, radiusAddress, radiusMepAddress, timer, tries, secret}). +-record(masT_ipSegment, {startSegAddress, stopSegAddress, netmask}). +-record(masT_llf, {name, metric, id}). +-record(masT_apnLink, {ggsnAddress, ipSegList, ipAddressOrigin, llfConnName, mepAddress}). +-record(masT_ispSubObj, {label, value}). +-record(masT_ipcpData, {type, ipAddress, rawMessage}). +-record(masT_ipcp, {exists, code, id, ipcpList}). +-record(masT_pap, {exists, code, id, username, password}). +-record(masT_chap, {code, id, value, name}). +-record(masT_ispDevContextData, {nsapi, ipAddress, apnhandle}). +-record(masT_protocolConfigOptions, {chap, pap, ipcp}). +-record(masT_apnRadius, {radiusAddress, timer, tries, secret}). +-record(masT_outbandRadius, {gwAddress, llfConnName, primRadius, secRadius}). +-record(masT_radiusPair, {primRadius, secRadius}). +-record(masT_radiusOpt, {dummyMsisdnAuth, dummyMsisdnAcct, msisdnInAuth, msisdnInAcct, sendFullImsi, sendMccMnc, sendSelMode, sendChargingId, asynchAcct}). +-record(masT_radiusConfig, {hostApn, authPair, acctList, radiusOptions}). +-record(masT_apnConfig, {link, security, radiusConfig, primDns, secDns, dhcpAddress, indAcct, indAuth, userNameBasedSelection}). + +-endif. diff --git a/lib/hipe/test/bs_SUITE_data/bs_des.erl b/lib/hipe/test/bs_SUITE_data/bs_des.erl new file mode 100644 index 0000000000..9c495d37ad --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_des.erl @@ -0,0 +1,734 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% File : bs_des.erl +%%% Author : Per Gustafsson <[email protected]> +%%% Purpose : An implementation of the DES Encryption/Descryption +%%% algorithm using Erlang binaries. +%%% +%%% Created : 14 Apr 2004 +%%%------------------------------------------------------------------- +-module(bs_des). + +-export([encode/2, decode/2, test/0]). + +-define(ITERATIONS, 42). %% for benchmarking use a higher number + +test() -> + Bin = <<1:64>>, + Size= byte_size(Bin), + Key = <<4704650607608769871263876:64>>, + Jumbled = run_encode(?ITERATIONS, Bin, Key), + Unjumbled = run_decode(?ITERATIONS, Jumbled, Key), + <<Bin:Size/binary,_/binary>> = Unjumbled, + ok. + +run_encode(1, Bin, Key) -> + encode(Bin, Key); +run_encode(N, Bin, Key) -> + encode(Bin, Key), + run_encode(N-1, Bin, Key). + +run_decode(1, Bin, Key) -> + decode(Bin, Key); +run_decode(N, Bin, Key) -> + decode(Bin, Key), + run_decode(N-1, Bin, Key). + +encode(Data, Key) -> + Keys = schedule(Key), + list_to_binary(encode_data(Data, Keys)). + +decode(Data, Key) -> + Keys = lists:reverse(schedule(Key)), + list_to_binary(decode_data(Data, Keys)). + +encode_data(<<Data:8/binary, Rest/binary>>, Keys) -> + [ipinv(des_core(ip(Data), Keys))|encode_data(Rest, Keys)]; +encode_data(<<Rest/binary>>, Keys) -> + case byte_size(Rest) of + 0 -> []; + X -> + Y = 8 - X, + Data = <<Rest/binary, 0:Y/integer-unit:8>>, + [ipinv(des_core(ip(Data), Keys))] + end. + +decode_data(<<Data:8/binary, Rest/binary>>, Keys) -> + [ipinv(dechiper(ip(Data), Keys))|decode_data(Rest, Keys)]; +decode_data(_, _Keys) -> + []. + +schedule(Key) -> + NewKey = pc1(Key), + subkeys(NewKey, 1). + +subkeys(_Key, 17) -> + []; +subkeys(Key, N) -> + TmpKey = + case rotate(N) of + 1 -> + <<X1:1, L:27, X2:1, R:27>> = Key, + <<L:27, X1:1, R:27, X2:1>>; + 2 -> + <<X1:2, L:26, X2:2, R:26>> = Key, + <<L:26, X1:2, R:26, X2:2>> + end, + [pc2(TmpKey)|subkeys(TmpKey, N+1)]. + +pc2(<<I1:1, I2:1, I3:1, I4:1, I5:1, I6:1, I7:1, I8:1, + _I9:1, I10:1, I11:1, I12:1, I13:1, I14:1, I15:1, I16:1, + I17:1, _I18:1, I19:1, I20:1, I21:1, _I22:1, I23:1, I24:1, + _I25:1, I26:1, I27:1, I28:1, I29:1, I30:1, I31:1, I32:1, + I33:1, I34:1, _I35:1, I36:1, I37:1, _I38:1, I39:1, I40:1, + I41:1, I42:1, _I43:1, I44:1, I45:1, I46:1, I47:1, I48:1, + I49:1, I50:1, I51:1, I52:1, I53:1, _I54:1, I55:1, I56:1>>) -> + <<I14:1, I17:1, I11:1, I24:1, I1:1, I5:1, I3:1, I28:1, + I15:1, I6:1, I21:1, I10:1, I23:1, I19:1, I12:1, I4:1, + I26:1, I8:1, I16:1, I7:1, I27:1, I20:1, I13:1, I2:1, + I41:1, I52:1, I31:1, I37:1, I47:1, I55:1, I30:1, I40:1, + I51:1, I45:1, I33:1, I48:1, I44:1, I49:1, I39:1, I56:1, + I34:1, I53:1, I46:1, I42:1, I50:1, I36:1, I29:1, I32:1>>. + +pc1(<<I1:1, I2:1, I3:1, I4:1, I5:1, I6:1, I7:1, _:1, + I9:1, I10:1, I11:1, I12:1, I13:1, I14:1, I15:1, _:1, + I17:1, I18:1, I19:1, I20:1, I21:1, I22:1, I23:1, _:1, + I25:1, I26:1, I27:1, I28:1, I29:1, I30:1, I31:1, _:1, + I33:1, I34:1, I35:1, I36:1, I37:1, I38:1, I39:1, _:1, + I41:1, I42:1, I43:1, I44:1, I45:1, I46:1, I47:1, _:1, + I49:1, I50:1, I51:1, I52:1, I53:1, I54:1, I55:1, _:1, + I57:1, I58:1, I59:1, I60:1, I61:1, I62:1, I63:1, _:1>>) -> + <<I57:1, I49:1, I41:1, I33:1, I25:1, I17:1, I9:1, I1:1, + I58:1, I50:1, I42:1, I34:1, I26:1, I18:1, I10:1, I2:1, + I59:1, I51:1, I43:1, I35:1, I27:1, I19:1, I11:1, I3:1, + I60:1, I52:1, I44:1, I36:1, I63:1, I55:1, I47:1, I39:1, + I31:1, I23:1, I15:1, I7:1, I62:1, I54:1, I46:1, I38:1, + I30:1, I22:1, I14:1, I6:1, I61:1, I53:1, I45:1, I37:1, + I29:1, I21:1, I13:1, I5:1, I28:1, I20:1, I12:1, I4:1>>. + +ip(<<I1:1, I2:1, I3:1, I4:1, I5:1, I6:1, I7:1, I8:1, + I9:1, I10:1, I11:1, I12:1, I13:1, I14:1, I15:1, I16:1, + I17:1, I18:1, I19:1, I20:1, I21:1, I22:1, I23:1, I24:1, + I25:1, I26:1, I27:1, I28:1, I29:1, I30:1, I31:1, I32:1, + I33:1, I34:1, I35:1, I36:1, I37:1, I38:1, I39:1, I40:1, + I41:1, I42:1, I43:1, I44:1, I45:1, I46:1, I47:1, I48:1, + I49:1, I50:1, I51:1, I52:1, I53:1, I54:1, I55:1, I56:1, + I57:1, I58:1, I59:1, I60:1, I61:1, I62:1, I63:1, I64:1>>) -> + <<I58:1, I50:1, I42:1, I34:1, I26:1, I18:1, I10:1, I2:1, + I60:1, I52:1, I44:1, I36:1, I28:1, I20:1, I12:1, I4:1, + I62:1, I54:1, I46:1, I38:1, I30:1, I22:1, I14:1, I6:1, + I64:1, I56:1, I48:1, I40:1, I32:1, I24:1, I16:1, I8:1, + I57:1, I49:1, I41:1, I33:1, I25:1, I17:1, I9:1, I1:1, + I59:1, I51:1, I43:1, I35:1, I27:1, I19:1, I11:1, I3:1, + I61:1, I53:1, I45:1, I37:1, I29:1, I21:1, I13:1, I5:1, + I63:1, I55:1, I47:1, I39:1, I31:1, I23:1, I15:1, I7:1>>. + +ipinv(<<I58:1, I50:1, I42:1, I34:1, I26:1, I18:1, I10:1, I2:1, + I60:1, I52:1, I44:1, I36:1, I28:1, I20:1, I12:1, I4:1, + I62:1, I54:1, I46:1, I38:1, I30:1, I22:1, I14:1, I6:1, + I64:1, I56:1, I48:1, I40:1, I32:1, I24:1, I16:1, I8:1, + I57:1, I49:1, I41:1, I33:1, I25:1, I17:1, I9:1, I1:1, + I59:1, I51:1, I43:1, I35:1, I27:1, I19:1, I11:1, I3:1, + I61:1, I53:1, I45:1, I37:1, I29:1, I21:1, I13:1, I5:1, + I63:1, I55:1, I47:1, I39:1, I31:1, I23:1, I15:1, I7:1>>) -> + <<I1:1, I2:1, I3:1, I4:1, I5:1, I6:1, I7:1, I8:1, + I9:1, I10:1, I11:1, I12:1, I13:1, I14:1, I15:1, I16:1, + I17:1, I18:1, I19:1, I20:1, I21:1, I22:1, I23:1, I24:1, + I25:1, I26:1, I27:1, I28:1, I29:1, I30:1, I31:1, I32:1, + I33:1, I34:1, I35:1, I36:1, I37:1, I38:1, I39:1, I40:1, + I41:1, I42:1, I43:1, I44:1, I45:1, I46:1, I47:1, I48:1, + I49:1, I50:1, I51:1, I52:1, I53:1, I54:1, I55:1, I56:1, + I57:1, I58:1, I59:1, I60:1, I61:1, I62:1, I63:1, I64:1>>. + +dechiper(<<L:4/binary, R:4/binary>>, Keys) -> + dechiper(L, R, Keys, 16). + +dechiper(L, R, [], 0) -> + <<L:4/binary, R:4/binary>>; +dechiper(L, R, [Key|Rest], I) -> + NewL = ebit(L), + XorL = xor48(NewL, Key), + Sboxed = sboxing(XorL), + Ped = p(Sboxed), + EndL = xor32(Ped, R), + dechiper(EndL, L, Rest, I-1). + +des_core(<<L:4/binary, R:4/binary>>, Keys) -> + des_core(L, R, Keys, 0). + +des_core(L, R, [], 16) -> + <<L:4/binary, R:4/binary>>; +des_core(L, R, [Key|Rest], I) when I<16 -> + NewR = ebit(R), + XorR = xor48(NewR, Key), + Sboxed = sboxing(XorR), + Ped = p(Sboxed), + EndR = xor32(Ped, L), + des_core(R, EndR, Rest, I+1). + +ebit(<<I1:1, I2:2, I3:2,I4:2,I5:2,I6:2, + I7:2,I8:2,I9:2,I10:2,I11:2,I12:2, + I13:2,I14:2,I15:2,I16:2,I17:1>>) -> + <<I17:1, I1:1, I2:2, I3:2, I3:2, + I4:2, I5:2, I5:2, I6:2, + I7:2, I7:2, I8:2, I9:2, + I9:2, I10:2, I11:2, I11:2, + I12:2, I13:2, I13:2, I14:2, + I15:2, I15:2, I16:2, I17:1, I1:1>>. + +p(<<I1:1, I2:1, I3:1, I4:1, I5:1, I6:1, I7:1, I8:1, + I9:1, I10:1, I11:1, I12:1, I13:1, I14:1, I15:1, I16:1, + I17:1, I18:1, I19:1, I20:1, I21:1, I22:1, I23:1, I24:1, + I25:1, I26:1, I27:1, I28:1, I29:1, I30:1, I31:1, I32:1>>) -> + <<I16:1, I7:1, I20:1, I21:1, I29:1, I12:1, I28:1, I17:1, + I1:1, I15:1, I23:1, I26:1, I5:1, I18:1, I31:1, I10:1, + I2:1, I8:1, I24:1, I14:1, I32:1, I27:1, I3:1, I9:1, + I19:1, I13:1, I30:1, I6:1, I22:1, I11:1, I4:1, I25:1>>. + +rotate(1) -> 1; +rotate(2) -> 1; +rotate(9) -> 1; +rotate(16) -> 1; +rotate(N) when N>0, N<17 -> 2. + +%% xor64(<<I1:16, I2:16, I3:16, I4:16>>,<<J1:16, J2:16, J3:16, J4:16>>) -> +%% K1 = I1 bxor J1, +%% K2 = I2 bxor J2, +%% K3 = I3 bxor J3, +%% K4 = I4 bxor J4, +%% <<K1:16, K2:16, K3:16, K4:16>>. + +xor48(<<I1:16, I2:16, I3:16>>,<<J1:16, J2:16, J3:16>>) -> + K1 = I1 bxor J1, + K2 = I2 bxor J2, + K3 = I3 bxor J3, + <<K1:16, K2:16, K3:16>>. + +xor32(<<I1:16, I2:16>>,<<J1:16, J2:16>>) -> + K1 = I1 bxor J1, + K2 = I2 bxor J2, + <<K1:16, K2:16>>. + +sboxing(<<A1:6, A2:6, A3:6, A4:6, A5:6, A6:6, A7:6, A8:6>>) -> + S1 = sbox(A1, 1), + S2 = sbox(A2, 2), + S3 = sbox(A3, 3), + S4 = sbox(A4, 4), + S5 = sbox(A5, 5), + S6 = sbox(A6, 6), + S7 = sbox(A7, 7), + S8 = sbox(A8, 8), + <<S1:4,S2:4,S3:4,S4:4,S5:4,S6:4,S7:4,S8:4>>. + +sbox(0,1) -> 14; +sbox(1,1) -> 0; +sbox(2,1) -> 4; +sbox(3,1) -> 15; +sbox(4,1) -> 13; +sbox(5,1) -> 7; +sbox(6,1) -> 1; +sbox(7,1) -> 4; +sbox(8,1) -> 2; +sbox(9,1) -> 14; +sbox(10,1) -> 15; +sbox(11,1) -> 2; +sbox(12,1) -> 11; +sbox(13,1) -> 13; +sbox(14,1) -> 8; +sbox(15,1) -> 1; +sbox(16,1) -> 3; +sbox(17,1) -> 10; +sbox(18,1) -> 10; +sbox(19,1) -> 6; +sbox(20,1) -> 6; +sbox(21,1) -> 12; +sbox(22,1) -> 12; +sbox(23,1) -> 11; +sbox(24,1) -> 5; +sbox(25,1) -> 9; +sbox(26,1) -> 9; +sbox(27,1) -> 5; +sbox(28,1) -> 0; +sbox(29,1) -> 3; +sbox(30,1) -> 7; +sbox(31,1) -> 8; +sbox(32,1) -> 4; +sbox(33,1) -> 15; +sbox(34,1) -> 1; +sbox(35,1) -> 12; +sbox(36,1) -> 14; +sbox(37,1) -> 8; +sbox(38,1) -> 8; +sbox(39,1) -> 2; +sbox(40,1) -> 13; +sbox(41,1) -> 4; +sbox(42,1) -> 6; +sbox(43,1) -> 9; +sbox(44,1) -> 2; +sbox(45,1) -> 1; +sbox(46,1) -> 11; +sbox(47,1) -> 7; +sbox(48,1) -> 15; +sbox(49,1) -> 5; +sbox(50,1) -> 12; +sbox(51,1) -> 11; +sbox(52,1) -> 9; +sbox(53,1) -> 3; +sbox(54,1) -> 7; +sbox(55,1) -> 14; +sbox(56,1) -> 3; +sbox(57,1) -> 10; +sbox(58,1) -> 10; +sbox(59,1) -> 0; +sbox(60,1) -> 5; +sbox(61,1) -> 6; +sbox(62,1) -> 0; +sbox(63,1) -> 13; +sbox(0,2) -> 15; +sbox(1,2) -> 3; +sbox(2,2) -> 1; +sbox(3,2) -> 13; +sbox(4,2) -> 8; +sbox(5,2) -> 4; +sbox(6,2) -> 14; +sbox(7,2) -> 7; +sbox(8,2) -> 6; +sbox(9,2) -> 15; +sbox(10,2) -> 11; +sbox(11,2) -> 2; +sbox(12,2) -> 3; +sbox(13,2) -> 8; +sbox(14,2) -> 4; +sbox(15,2) -> 14; +sbox(16,2) -> 9; +sbox(17,2) -> 12; +sbox(18,2) -> 7; +sbox(19,2) -> 0; +sbox(20,2) -> 2; +sbox(21,2) -> 1; +sbox(22,2) -> 13; +sbox(23,2) -> 10; +sbox(24,2) -> 12; +sbox(25,2) -> 6; +sbox(26,2) -> 0; +sbox(27,2) -> 9; +sbox(28,2) -> 5; +sbox(29,2) -> 11; +sbox(30,2) -> 10; +sbox(31,2) -> 5; +sbox(32,2) -> 0; +sbox(33,2) -> 13; +sbox(34,2) -> 14; +sbox(35,2) -> 8; +sbox(36,2) -> 7; +sbox(37,2) -> 10; +sbox(38,2) -> 11; +sbox(39,2) -> 1; +sbox(40,2) -> 10; +sbox(41,2) -> 3; +sbox(42,2) -> 4; +sbox(43,2) -> 15; +sbox(44,2) -> 13; +sbox(45,2) -> 4; +sbox(46,2) -> 1; +sbox(47,2) -> 2; +sbox(48,2) -> 5; +sbox(49,2) -> 11; +sbox(50,2) -> 8; +sbox(51,2) -> 6; +sbox(52,2) -> 12; +sbox(53,2) -> 7; +sbox(54,2) -> 6; +sbox(55,2) -> 12; +sbox(56,2) -> 9; +sbox(57,2) -> 0; +sbox(58,2) -> 3; +sbox(59,2) -> 5; +sbox(60,2) -> 2; +sbox(61,2) -> 14; +sbox(62,2) -> 15; +sbox(63,2) -> 9; +sbox(0,3) -> 10; +sbox(1,3) -> 13; +sbox(2,3) -> 0; +sbox(3,3) -> 7; +sbox(4,3) -> 9; +sbox(5,3) -> 0; +sbox(6,3) -> 14; +sbox(7,3) -> 9; +sbox(8,3) -> 6; +sbox(9,3) -> 3; +sbox(10,3) -> 3; +sbox(11,3) -> 4; +sbox(12,3) -> 15; +sbox(13,3) -> 6; +sbox(14,3) -> 5; +sbox(15,3) -> 10; +sbox(16,3) -> 1; +sbox(17,3) -> 2; +sbox(18,3) -> 13; +sbox(19,3) -> 8; +sbox(20,3) -> 12; +sbox(21,3) -> 5; +sbox(22,3) -> 7; +sbox(23,3) -> 14; +sbox(24,3) -> 11; +sbox(25,3) -> 12; +sbox(26,3) -> 4; +sbox(27,3) -> 11; +sbox(28,3) -> 2; +sbox(29,3) -> 15; +sbox(30,3) -> 8; +sbox(31,3) -> 1; +sbox(32,3) -> 13; +sbox(33,3) -> 1; +sbox(34,3) -> 6; +sbox(35,3) -> 10; +sbox(36,3) -> 4; +sbox(37,3) -> 13; +sbox(38,3) -> 9; +sbox(39,3) -> 0; +sbox(40,3) -> 8; +sbox(41,3) -> 6; +sbox(42,3) -> 15; +sbox(43,3) -> 9; +sbox(44,3) -> 3; +sbox(45,3) -> 8; +sbox(46,3) -> 0; +sbox(47,3) -> 7; +sbox(48,3) -> 11; +sbox(49,3) -> 4; +sbox(50,3) -> 1; +sbox(51,3) -> 15; +sbox(52,3) -> 2; +sbox(53,3) -> 14; +sbox(54,3) -> 12; +sbox(55,3) -> 3; +sbox(56,3) -> 5; +sbox(57,3) -> 11; +sbox(58,3) -> 10; +sbox(59,3) -> 5; +sbox(60,3) -> 14; +sbox(61,3) -> 2; +sbox(62,3) -> 7; +sbox(63,3) -> 12; +sbox(0,4) -> 7; +sbox(1,4) -> 13; +sbox(2,4) -> 13; +sbox(3,4) -> 8; +sbox(4,4) -> 14; +sbox(5,4) -> 11; +sbox(6,4) -> 3; +sbox(7,4) -> 5; +sbox(8,4) -> 0; +sbox(9,4) -> 6; +sbox(10,4) -> 6; +sbox(11,4) -> 15; +sbox(12,4) -> 9; +sbox(13,4) -> 0; +sbox(14,4) -> 10; +sbox(15,4) -> 3; +sbox(16,4) -> 1; +sbox(17,4) -> 4; +sbox(18,4) -> 2; +sbox(19,4) -> 7; +sbox(20,4) -> 8; +sbox(21,4) -> 2; +sbox(22,4) -> 5; +sbox(23,4) -> 12; +sbox(24,4) -> 11; +sbox(25,4) -> 1; +sbox(26,4) -> 12; +sbox(27,4) -> 10; +sbox(28,4) -> 4; +sbox(29,4) -> 14; +sbox(30,4) -> 15; +sbox(31,4) -> 9; +sbox(32,4) -> 10; +sbox(33,4) -> 3; +sbox(34,4) -> 6; +sbox(35,4) -> 15; +sbox(36,4) -> 9; +sbox(37,4) -> 0; +sbox(38,4) -> 0; +sbox(39,4) -> 6; +sbox(40,4) -> 12; +sbox(41,4) -> 10; +sbox(42,4) -> 11; +sbox(43,4) -> 1; +sbox(44,4) -> 7; +sbox(45,4) -> 13; +sbox(46,4) -> 13; +sbox(47,4) -> 8; +sbox(48,4) -> 15; +sbox(49,4) -> 9; +sbox(50,4) -> 1; +sbox(51,4) -> 4; +sbox(52,4) -> 3; +sbox(53,4) -> 5; +sbox(54,4) -> 14; +sbox(55,4) -> 11; +sbox(56,4) -> 5; +sbox(57,4) -> 12; +sbox(58,4) -> 2; +sbox(59,4) -> 7; +sbox(60,4) -> 8; +sbox(61,4) -> 2; +sbox(62,4) -> 4; +sbox(63,4) -> 14; +sbox(0,5) -> 2; +sbox(1,5) -> 14; +sbox(2,5) -> 12; +sbox(3,5) -> 11; +sbox(4,5) -> 4; +sbox(5,5) -> 2; +sbox(6,5) -> 1; +sbox(7,5) -> 12; +sbox(8,5) -> 7; +sbox(9,5) -> 4; +sbox(10,5) -> 10; +sbox(11,5) -> 7; +sbox(12,5) -> 11; +sbox(13,5) -> 13; +sbox(14,5) -> 6; +sbox(15,5) -> 1; +sbox(16,5) -> 8; +sbox(17,5) -> 5; +sbox(18,5) -> 5; +sbox(19,5) -> 0; +sbox(20,5) -> 3; +sbox(21,5) -> 15; +sbox(22,5) -> 15; +sbox(23,5) -> 10; +sbox(24,5) -> 13; +sbox(25,5) -> 3; +sbox(26,5) -> 0; +sbox(27,5) -> 9; +sbox(28,5) -> 14; +sbox(29,5) -> 8; +sbox(30,5) -> 9; +sbox(31,5) -> 6; +sbox(32,5) -> 4; +sbox(33,5) -> 11; +sbox(34,5) -> 2; +sbox(35,5) -> 8; +sbox(36,5) -> 1; +sbox(37,5) -> 12; +sbox(38,5) -> 11; +sbox(39,5) -> 7; +sbox(40,5) -> 10; +sbox(41,5) -> 1; +sbox(42,5) -> 13; +sbox(43,5) -> 14; +sbox(44,5) -> 7; +sbox(45,5) -> 2; +sbox(46,5) -> 8; +sbox(47,5) -> 13; +sbox(48,5) -> 15; +sbox(49,5) -> 6; +sbox(50,5) -> 9; +sbox(51,5) -> 15; +sbox(52,5) -> 12; +sbox(53,5) -> 0; +sbox(54,5) -> 5; +sbox(55,5) -> 9; +sbox(56,5) -> 6; +sbox(57,5) -> 10; +sbox(58,5) -> 3; +sbox(59,5) -> 4; +sbox(60,5) -> 0; +sbox(61,5) -> 5; +sbox(62,5) -> 14; +sbox(63,5) -> 3; +sbox(0,6) -> 12; +sbox(1,6) -> 10; +sbox(2,6) -> 1; +sbox(3,6) -> 15; +sbox(4,6) -> 10; +sbox(5,6) -> 4; +sbox(6,6) -> 15; +sbox(7,6) -> 2; +sbox(8,6) -> 9; +sbox(9,6) -> 7; +sbox(10,6) -> 2; +sbox(11,6) -> 12; +sbox(12,6) -> 6; +sbox(13,6) -> 9; +sbox(14,6) -> 8; +sbox(15,6) -> 5; +sbox(16,6) -> 0; +sbox(17,6) -> 6; +sbox(18,6) -> 13; +sbox(19,6) -> 1; +sbox(20,6) -> 3; +sbox(21,6) -> 13; +sbox(22,6) -> 4; +sbox(23,6) -> 14; +sbox(24,6) -> 14; +sbox(25,6) -> 0; +sbox(26,6) -> 7; +sbox(27,6) -> 11; +sbox(28,6) -> 5; +sbox(29,6) -> 3; +sbox(30,6) -> 11; +sbox(31,6) -> 8; +sbox(32,6) -> 9; +sbox(33,6) -> 4; +sbox(34,6) -> 14; +sbox(35,6) -> 3; +sbox(36,6) -> 15; +sbox(37,6) -> 2; +sbox(38,6) -> 5; +sbox(39,6) -> 12; +sbox(40,6) -> 2; +sbox(41,6) -> 9; +sbox(42,6) -> 8; +sbox(43,6) -> 5; +sbox(44,6) -> 12; +sbox(45,6) -> 15; +sbox(46,6) -> 3; +sbox(47,6) -> 10; +sbox(48,6) -> 7; +sbox(49,6) -> 11; +sbox(50,6) -> 0; +sbox(51,6) -> 14; +sbox(52,6) -> 4; +sbox(53,6) -> 1; +sbox(54,6) -> 10; +sbox(55,6) -> 7; +sbox(56,6) -> 1; +sbox(57,6) -> 6; +sbox(58,6) -> 13; +sbox(59,6) -> 0; +sbox(60,6) -> 11; +sbox(61,6) -> 8; +sbox(62,6) -> 6; +sbox(63,6) -> 13; +sbox(0,7) -> 4; +sbox(1,7) -> 13; +sbox(2,7) -> 11; +sbox(3,7) -> 0; +sbox(4,7) -> 2; +sbox(5,7) -> 11; +sbox(6,7) -> 14; +sbox(7,7) -> 7; +sbox(8,7) -> 15; +sbox(9,7) -> 4; +sbox(10,7) -> 0; +sbox(11,7) -> 9; +sbox(12,7) -> 8; +sbox(13,7) -> 1; +sbox(14,7) -> 13; +sbox(15,7) -> 10; +sbox(16,7) -> 3; +sbox(17,7) -> 14; +sbox(18,7) -> 12; +sbox(19,7) -> 3; +sbox(20,7) -> 9; +sbox(21,7) -> 5; +sbox(22,7) -> 7; +sbox(23,7) -> 12; +sbox(24,7) -> 5; +sbox(25,7) -> 2; +sbox(26,7) -> 10; +sbox(27,7) -> 15; +sbox(28,7) -> 6; +sbox(29,7) -> 8; +sbox(30,7) -> 1; +sbox(31,7) -> 6; +sbox(32,7) -> 1; +sbox(33,7) -> 6; +sbox(34,7) -> 4; +sbox(35,7) -> 11; +sbox(36,7) -> 11; +sbox(37,7) -> 13; +sbox(38,7) -> 13; +sbox(39,7) -> 8; +sbox(40,7) -> 12; +sbox(41,7) -> 1; +sbox(42,7) -> 3; +sbox(43,7) -> 4; +sbox(44,7) -> 7; +sbox(45,7) -> 10; +sbox(46,7) -> 14; +sbox(47,7) -> 7; +sbox(48,7) -> 10; +sbox(49,7) -> 9; +sbox(50,7) -> 15; +sbox(51,7) -> 5; +sbox(52,7) -> 6; +sbox(53,7) -> 0; +sbox(54,7) -> 8; +sbox(55,7) -> 15; +sbox(56,7) -> 0; +sbox(57,7) -> 14; +sbox(58,7) -> 5; +sbox(59,7) -> 2; +sbox(60,7) -> 9; +sbox(61,7) -> 3; +sbox(62,7) -> 2; +sbox(63,7) -> 12; +sbox(0,8) -> 13; +sbox(1,8) -> 1; +sbox(2,8) -> 2; +sbox(3,8) -> 15; +sbox(4,8) -> 8; +sbox(5,8) -> 13; +sbox(6,8) -> 4; +sbox(7,8) -> 8; +sbox(8,8) -> 6; +sbox(9,8) -> 10; +sbox(10,8) -> 15; +sbox(11,8) -> 3; +sbox(12,8) -> 11; +sbox(13,8) -> 7; +sbox(14,8) -> 1; +sbox(15,8) -> 4; +sbox(16,8) -> 10; +sbox(17,8) -> 12; +sbox(18,8) -> 9; +sbox(19,8) -> 5; +sbox(20,8) -> 3; +sbox(21,8) -> 6; +sbox(22,8) -> 14; +sbox(23,8) -> 11; +sbox(24,8) -> 5; +sbox(25,8) -> 0; +sbox(26,8) -> 0; +sbox(27,8) -> 14; +sbox(28,8) -> 12; +sbox(29,8) -> 9; +sbox(30,8) -> 7; +sbox(31,8) -> 2; +sbox(32,8) -> 7; +sbox(33,8) -> 2; +sbox(34,8) -> 11; +sbox(35,8) -> 1; +sbox(36,8) -> 4; +sbox(37,8) -> 14; +sbox(38,8) -> 1; +sbox(39,8) -> 7; +sbox(40,8) -> 9; +sbox(41,8) -> 4; +sbox(42,8) -> 12; +sbox(43,8) -> 10; +sbox(44,8) -> 14; +sbox(45,8) -> 8; +sbox(46,8) -> 2; +sbox(47,8) -> 13; +sbox(48,8) -> 0; +sbox(49,8) -> 15; +sbox(50,8) -> 6; +sbox(51,8) -> 12; +sbox(52,8) -> 10; +sbox(53,8) -> 9; +sbox(54,8) -> 13; +sbox(55,8) -> 0; +sbox(56,8) -> 15; +sbox(57,8) -> 3; +sbox(58,8) -> 3; +sbox(59,8) -> 5; +sbox(60,8) -> 5; +sbox(61,8) -> 6; +sbox(62,8) -> 8; +sbox(63,8) -> 11. diff --git a/lib/hipe/test/bs_SUITE_data/bs_extract.erl b/lib/hipe/test/bs_SUITE_data/bs_extract.erl new file mode 100644 index 0000000000..0492689fa8 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_extract.erl @@ -0,0 +1,94 @@ +%% -*- erlang-indent-level: 2 -*- +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +%% +%% Among testing other things, this module shows why performing LCM on +%% SPARC is currently problematic. SPARC does not mark untagged values +%% as dead when they are live over function calls which in turn causes +%% them to be traced by the garbage collector leading to crashes. +%% +%% A simple way to get this behaviour is to compile just the function +%% +%% {bsextract,tid_internal_storage,2} +%% +%% with the compiler option "rtl_lcm" on and without. +%% +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% + +-module(bs_extract). + +-export([test/0]). + +-include("bs_decode_extract.hrl"). + +-define(PDU, <<30,16,0,90,0,1,0,0,255,255,255,255,81,67,101,7,0,0,0,96, + 6,12,146,18,14,0,15,252,16,0,0,17,0,0,128,0,2,241,33,131, + 0,20,7,97,112,110,48,49,51,97,8,101,114,105,99,115,115, + 111,110,2,115,101,132,0,20,128,192,35,16,1,5,0,16,5,117, + 115,101,114,53,5,112,97,115,115,53,133,0,4,172,28,12,1, + 133,0,4,172,28,12,3,134,0,8,145,148,113,129,0,0,0,0>>). + +-define(RES, {ok, {mvsgT_imsi, <<81,67,101,7,0,0,0,240>>}}). + +test() -> + ?RES = extract_v0_opt(1000, ?PDU), + ok. + +extract_v0_opt(0, Pdu) -> + get_external_id(Pdu); +extract_v0_opt(N, Pdu) -> + {ok,_} = get_external_id(Pdu), + extract_v0_opt(N-1, Pdu). + +get_external_id(<<0:3,_:4,0:1,1:8,_Length:16,SequenceNumber:16, + _FlowLabel:16,_SNDCP_N_PDU_Number:8,_:3/binary-unit:8, + _TID:8/binary-unit:8,_InformationElements/binary>>) -> + {echo,#sesT_echoReqV0{},SequenceNumber}; +%% Create PDP Context Request +%% GTP97, SNN=0 +%% (No SNDCP N-PDU number) +get_external_id(<<0:3,_:4,0:1,16:8,_Length:16,_SequenceNumber:16, + _FlowLabel:16,_SNDCP_N_PDU_Number:8,_:3/binary-unit:8, + TID:8/binary-unit:8,_InformationElements/binary>>) -> + {ok,_IMSI} = extract_imsi(TID); +%%% Update PDP Context Request +%%% GTP97, SNN=0 +%%% (No SNDCP N-PDU number) +get_external_id(<<0:3,_:4,0:1,18:8,_Length:16,_SequenceNumber:16, + _FlowLabel:16,_SNDCP_N_PDU_Number:8,_:3/binary-unit:8, + TID:8/binary-unit:8,_InformationElements/binary>>) -> + {ok,_IMSI} = extract_imsi(TID); +%%% Delete PDP Context Request +%%% GTP97, SNN=0 +%%% (No SNDCP N-PDU number) +get_external_id(<<0:3,_:4,0:1,20:8,_Length:16,_SequenceNumber:16, + _FlowLabel:16,_SNDCP_N_PDU_Number:8,_:3/binary-unit:8, + TID:8/binary-unit:8,_InformationElements/binary>>) -> + {ok,_IMSI} = extract_imsi(TID); +%%% Error handling: GTP Message Too Short +%%% Error handling: Unknown GTP Signalling message. +%%% Error handling: Unexpected GTP Signalling message. +get_external_id(_GTP_Message) -> + fault. + +%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%% extract_imsi/1 +%% Get the IMSI element from TID +extract_imsi(TID) -> + {ok,#mvsgT_tid{imsi=IMSI}} = tid_internal_storage(TID,[]), + {ok,IMSI}. + +%%% - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - +%%% tid_internal_storage/3 +%%% Convert TID binary to internal datatype +tid_internal_storage(Bin,_) -> + Size = byte_size(Bin) - 1, + <<Front:Size/binary,NSAPI:4,DigitN:4>> = Bin, + Result = + case DigitN of + 2#1111 -> + #mvsgT_tid{imsi = #mvsgT_imsi{value=Front}, nsapi = NSAPI}; + _ -> + Value = <<Front/binary,2#1111:4,DigitN:4>>, + #mvsgT_tid{imsi = #mvsgT_imsi{value = Value}, nsapi = NSAPI} + end, + {ok,Result}. diff --git a/lib/hipe/test/bs_SUITE_data/bs_flatb.erl b/lib/hipe/test/bs_SUITE_data/bs_flatb.erl new file mode 100644 index 0000000000..6163917965 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_flatb.erl @@ -0,0 +1,29 @@ +%% -*- erlang-indent-level: 2 -*- +%%-------------------------------------------------------------------------- +%% Program which resulted in a badarg crash when compiled to native code. +%% The problem was that hipe_icode_primops was stating that the primop +%% {bs_start_match, ok_matchstate} could not fail which made the icode_type +%% pass removing the third clause of flatb/1. +%% +%% (The program was working correctly with hipe option 'no_icode_type'.) +%% +%% Reported by Andreas Sandberg on 3/1/2011 and fixed by Kostis on 5/1/2011 +%% with the help of Per Gustafsson. +%% -------------------------------------------------------------------------- +-module(bs_flatb). + +-export([hipe_options/0, test/0]). + +hipe_options() -> + [icode_type]. + +test() -> + [] = flatb([<<>>], []), + ok. + +flatb(<<X:8, Rest/binary>>, Acc) -> + flatb(Rest, [X|Acc]); +flatb(<<>>, Acc) -> + Acc; +flatb([V], Acc) -> + flatb(V, Acc). diff --git a/lib/hipe/test/bs_SUITE_data/bs_id3.erl b/lib/hipe/test/bs_SUITE_data/bs_id3.erl new file mode 100644 index 0000000000..a6152f05cd --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_id3.erl @@ -0,0 +1,75 @@ +%% -*- erlang-indent-level: 2 -*- +%%========================================================================== +%% From: Tomas Stejskal -- 23/02/2008 +%% I've found some strange behavior regarding binary matching. The module's +%% purpose is reading an id3 version 1 or version 1.1 tag from an mp3 bin. +%% When I use the function read_v1_or_v11_tag on a mp3 binary containing +%% version 1 tag, it returns an error. However, when the function +%% read_only_v1_tag is applied on the same file, it reads the tag data +%% correctly. The only difference between these two functions is that the +%% former has an extra branch to read version 1.1 tag. +%% This was a BEAM compiler bug which was fixed by a patch to beam_dead. +%%========================================================================== + +-module(bs_id3). + +-export([test/0]). + +-define(BIN, <<84,65,71,68,117,154,105,232,107,121,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,68,97,110,105,101,108,32,76,97,110, + 100,97,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,66,101,115,116, + 32,79,102,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 50,48,48,48,50,48,48,48,32,45,32,66,101,115,116,32,79,102, + 32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,32,12>>). + +test() -> + R1 = parse_only_v1_tag(?BIN), + R2 = parse_v1_or_v11_tag(?BIN), + %% io:format("~p\n~p\n", [R1, R2]), + R1 = R2, % crash if not equal + ok. + +parse_only_v1_tag(<<"TAG", Title:30/binary, + Artist:30/binary, Album:30/binary, + _Year:4/binary, _Comment:30/binary, + _Genre:8>>) -> + {ok, + {"ID3v1", + [{title, trim(Title)}, + {artist, trim(Artist)}, + {album, trim(Album)}]}}; +parse_only_v1_tag(_) -> + error. + +parse_v1_or_v11_tag(<<"TAG", Title:30/binary, + Artist:30/binary, Album:30/binary, + _Year:4/binary, _Comment:28/binary, + 0:8, Track:8, _Genre:8>>) -> + {ok, + {"ID3v1.1", + [{track, Track}, {title, trim(Title)}, + {artist, trim(Artist)}, {album, trim(Album)}]}}; +parse_v1_or_v11_tag(<<"TAG", Title:30/binary, + Artist:30/binary, Album:30/binary, + _Year:4/binary, _Comment:30/binary, + _Genre:8>>) -> + {ok, + {"ID3v1", + [{title, trim(Title)}, + {artist, trim(Artist)}, + {album, trim(Album)}]}}; +parse_v1_or_v11_tag(_) -> + error. + +trim(Bin) -> + list_to_binary(trim_blanks(binary_to_list(Bin))). + +trim_blanks(L) -> + lists:reverse(skip_blanks_and_zero(lists:reverse(L))). + +skip_blanks_and_zero([$\s|T]) -> + skip_blanks_and_zero(T); +skip_blanks_and_zero([0|T]) -> + skip_blanks_and_zero(T); +skip_blanks_and_zero(L) -> + L. diff --git a/lib/hipe/test/bs_SUITE_data/bs_match.erl b/lib/hipe/test/bs_SUITE_data/bs_match.erl new file mode 100644 index 0000000000..b241ea8d35 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_match.erl @@ -0,0 +1,289 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% File : bs_match.erl +%%% Authors : Per Gustafsson <[email protected]>, Kostis Sagonas <[email protected]> +%%% Purpose : Tests matching and construction of binaries +%%% TODO : Add binary and float tests +%%% Created : 20 Feb 2004 +%%%------------------------------------------------------------------- +-module(bs_match). + +-export([test/0]). + +test() -> + Funs = [fun test_aligned/0, fun test_unaligned/0, + fun test_zero_tail/0, fun test_integer_matching/0, + fun test_writable_bin/0, fun test_match_huge_bin/0], + lists:foreach(fun (F) -> ok = F() end, Funs). + +%%------------------------------------------------------------------- +%% Test aligned accesses + +test_aligned() -> + 10 = aligned_skip_bits_all(1, <<10,11,12>>), + ok = aligned(). + +aligned_skip_bits_all(N, Bin) -> + <<X:N/integer-unit:8, _/binary>> = Bin, + X. + +aligned() -> + Tail1 = mkbin([]), + {258, Tail1} = al_get_tail_used(mkbin([1,2])), + Tail2 = mkbin(lists:seq(1, 127)), + {35091, Tail2} = al_get_tail_used(mkbin([137,19|Tail2])), + 64896 = al_get_tail_unused(mkbin([253,128])), + 64895 = al_get_tail_unused(mkbin([253,127|lists:seq(42, 255)])), + Tail3 = mkbin(lists:seq(0, 19)), + {0, Tail1} = get_dyn_tail_used(Tail1, 0), + {0, Tail3} = get_dyn_tail_used(mkbin([Tail3]), 0), + {73, Tail3} = get_dyn_tail_used(mkbin([73|Tail3]), 8), + 0 = get_dyn_tail_unused(mkbin([]), 0), + 233 = get_dyn_tail_unused(mkbin([233]), 8), + 23 = get_dyn_tail_unused(mkbin([23,22,2]), 8), + ok. + +mkbin(L) when is_list(L) -> list_to_binary(L). + +al_get_tail_used(<<A:16,T/binary>>) -> {A, T}. + +al_get_tail_unused(<<A:16,_/binary>>) -> A. + +%%------------------------------------------------------------------- +%% Test unaligned accesses + +test_unaligned() -> + 10 = unaligned_skip_bits_all(8, <<10,11,12>>), + ok = unaligned(). + +unaligned_skip_bits_all(N, Bin) -> + <<X:N, _/binary>> = Bin, + X. + +unaligned() -> + {'EXIT', {function_clause,_}} = (catch get_tail_used(mkbin([42]))), + {'EXIT', {{badmatch,_},_}} = (catch get_dyn_tail_used(mkbin([137]), 3)), + {'EXIT', {function_clause,_}} = (catch get_tail_unused(mkbin([42,33]))), + {'EXIT', {{badmatch,_},_}} = (catch get_dyn_tail_unused(mkbin([44]), 7)), + ok. + +get_tail_used(<<A:1, T/binary>>) -> {A, T}. + +get_tail_unused(<<A:15, _/binary>>) -> A. + +get_dyn_tail_used(Bin, Sz) -> + <<A:Sz, T/binary>> = Bin, + {A,T}. + +get_dyn_tail_unused(Bin, Sz) -> + <<A:Sz, _T/binary>> = Bin, + A. + +%%------------------------------------------------------------------- +%% Test zero tail + +test_zero_tail() -> + 42 = zt8(mkbin([42])), + {'EXIT', {function_clause, _}} = (catch zt8(mkbin([1,2]))), + {'EXIT', {function_clause, _}} = (catch zt44(mkbin([1,2]))), + ok. + +zt8(<<A:8>>) -> A. + +zt44(<<_:4,_:4>>) -> ok. + +%%------------------------------------------------------------------- +%% Test integer matching + +test_integer_matching() -> + ok = test_static_integer_matching_1(), + ok = test_static_integer_matching_2(), + ok = test_static_integer_matching_3(), + ok = test_static_integer_matching_4(), + DynFun = fun (N) -> ok = test_dynamic_integer_matching(N) end, + lists:foreach(DynFun, [28, 27, 9, 17, 25, 8, 16, 24, 32]). + +test_static_integer_matching_1() -> + <<0:6, -25:28/integer-signed, 0:6>> = s11(), + <<0:6, -25:28/integer-little-signed, 0:6>> = s12(), + <<0:6, 25:28/integer-little, 0:6>> = s13(), + <<0:6, 25:28, 0:6>> = s14(), + ok. + +s11() -> + <<0:6, -25:28/integer-signed, 0:6>>. +s12() -> + <<0:6, -25:28/integer-little-signed, 0:6>>. +s13() -> + <<0:6, 25:28/integer-little, 0:6>>. +s14() -> + <<0:6, 25:28, 0:6>>. + +test_static_integer_matching_2() -> + <<0:6, -25:20/integer-signed, 0:6>> = s21(), + <<0:6, -25:20/integer-little-signed, 0:6>> = s22(), + <<0:6, 25:20/integer-little, 0:6>> = s23(), + <<0:6, 25:20, 0:6>> = s24(), + ok. + +s21() -> + <<0:6, -25:20/integer-signed, 0:6>>. +s22() -> + <<0:6, -25:20/integer-little-signed, 0:6>>. +s23() -> + <<0:6, 25:20/integer-little, 0:6>>. +s24() -> + <<0:6, 25:20, 0:6>>. + +test_static_integer_matching_3() -> + <<0:6, -25:12/integer-signed, 0:6>> = s31(), + <<0:6, -25:12/integer-little-signed, 0:6>> = s32(), + <<0:6, 25:12/integer-little, 0:6>> = s33(), + <<0:6, 25:12, 0:6>> = s34(), + ok. + +s31() -> + <<0:6, -25:12/integer-signed, 0:6>>. +s32() -> + <<0:6, -25:12/integer-little-signed, 0:6>>. +s33() -> + <<0:6, 25:12/integer-little, 0:6>>. +s34() -> + <<0:6, 25:12, 0:6>>. + +test_static_integer_matching_4() -> + <<0:6, -3:4/integer-signed, 0:6>> = s41(), + <<0:6, -3:4/integer-little-signed, 0:6>> = s42(), + <<0:6, 7:4/integer-little, 0:6>> = s43(), + <<0:6, 7:4, 0:6>> = s44(), + ok. + +s41() -> + <<0:6, -3:4/integer-signed, 0:6>>. +s42() -> + <<0:6, -3:4/integer-little-signed, 0:6>>. +s43() -> + <<0:6, 7:4/integer-little, 0:6>>. +s44() -> + <<0:6, 7:4, 0:6>>. + +test_dynamic_integer_matching(N) -> + S = 32 - N, + <<-12:N/integer-signed, 0:S>> = <<-12:N/integer-signed, 0:S>>, + <<-12:N/integer-little-signed, 0:S>> = <<-12:N/integer-little-signed, 0:S>>, + <<12:N/integer, 0:S>> = <<12:N/integer, 0:S>>, + <<12:N/integer-little, 0:S>> = <<12:N/integer-little, 0:S>>, + ok. + +%%------------------------------------------------------------------- +%% Test writable bin -- added by Sverker Eriksson + +test_writable_bin() -> + test_writable_bin(<<>>, 0), + ok. + +test_writable_bin(Bin, 128) -> + Bin; +test_writable_bin(Bin0, N) when N < 128 -> + Bin1 = <<Bin0/binary, N>>, + <<_/utf8, _/binary>> = Bin1, + test_writable_bin(Bin1, N+1). + +%%------------------------------------------------------------------- +%% Test matching with a huge bin -- taken from bs_match_bin_SUITE + +test_match_huge_bin() -> + Bin = <<0:(1 bsl 27),13:8>>, + skip_huge_bin_1(1 bsl 27, Bin), + 16777216 = match_huge_bin_1(1 bsl 27, Bin), + %% Test overflowing the size of a binary field. + nomatch = overflow_huge_bin_skip_32(Bin), + nomatch = overflow_huge_bin_32(Bin), + nomatch = overflow_huge_bin_skip_64(Bin), + nomatch = overflow_huge_bin_64(Bin), + %% Size in variable + ok = overflow_huge_bin(Bin, lists:seq(25, 32)++lists:seq(50, 64)), + ok = overflow_huge_bin_unit128(Bin, lists:seq(25, 32)++lists:seq(50, 64)), + ok. + +overflow_huge_bin(Bin, [Sz0|Sizes]) -> + Sz = id(1 bsl Sz0), + case Bin of + <<_:Sz/binary-unit:8,0,_/binary>> -> + {error,Sz}; + _ -> + case Bin of + <<NewBin:Sz/binary-unit:8,0,_/binary>> -> + {error,Sz,size(NewBin)}; + _ -> + overflow_huge_bin(Bin, Sizes) + end + end; +overflow_huge_bin(_, []) -> ok. + +overflow_huge_bin_unit128(Bin, [Sz0|Sizes]) -> + Sz = id(1 bsl Sz0), + case Bin of + <<_:Sz/binary-unit:128,0,_/binary>> -> + {error,Sz}; + _ -> + case Bin of + <<NewBin:Sz/binary-unit:128,0,_/binary>> -> + {error,Sz,size(NewBin)}; + _ -> + overflow_huge_bin_unit128(Bin, Sizes) + end + end; +overflow_huge_bin_unit128(_, []) -> ok. + +skip_huge_bin_1(I, Bin) -> + <<_:I/binary-unit:1,13>> = Bin, + ok. + +match_huge_bin_1(I, Bin) -> + case Bin of + <<Val:I/binary-unit:1,13>> -> size(Val); + _ -> nomatch + end. + +overflow_huge_bin_skip_32(<<_:4294967296/binary,0,_/binary>>) -> 1; % 1 bsl 32 +overflow_huge_bin_skip_32(<<_:33554432/binary-unit:128,0,_/binary>>) -> 2; % 1 bsl 25 +overflow_huge_bin_skip_32(<<_:67108864/binary-unit:64,0,_/binary>>) -> 3; % 1 bsl 26 +overflow_huge_bin_skip_32(<<_:134217728/binary-unit:32,0,_/binary>>) -> 4; % 1 bsl 27 +overflow_huge_bin_skip_32(<<_:268435456/binary-unit:16,0,_/binary>>) -> 5; % 1 bsl 28 +overflow_huge_bin_skip_32(<<_:536870912/binary-unit:8,0,_/binary>>) -> 6; % 1 bsl 29 +overflow_huge_bin_skip_32(<<_:1073741824/binary-unit:8,0,_/binary>>) -> 7; % 1 bsl 30 +overflow_huge_bin_skip_32(<<_:2147483648/binary-unit:8,0,_/binary>>) -> 8; % 1 bsl 31 +overflow_huge_bin_skip_32(_) -> nomatch. + +overflow_huge_bin_32(<<Bin:4294967296/binary,_/binary>>) -> {1,Bin}; % 1 bsl 32 +overflow_huge_bin_32(<<Bin:33554432/binary-unit:128,0,_/binary>>) -> {2,Bin}; % 1 bsl 25 +overflow_huge_bin_32(<<Bin:67108864/binary-unit:128,0,_/binary>>) -> {3,Bin}; % 1 bsl 26 +overflow_huge_bin_32(<<Bin:134217728/binary-unit:128,0,_/binary>>) -> {4,Bin}; % 1 bsl 27 +overflow_huge_bin_32(<<Bin:268435456/binary-unit:128,0,_/binary>>) -> {5,Bin}; % 1 bsl 28 +overflow_huge_bin_32(<<Bin:536870912/binary-unit:128,0,_/binary>>) -> {6,Bin}; % 1 bsl 29 +overflow_huge_bin_32(<<Bin:1073741824/binary-unit:128,0,_/binary>>) -> {7,Bin}; % 1 bsl 30 +overflow_huge_bin_32(<<Bin:2147483648/binary-unit:128,0,_/binary>>) -> {8,Bin}; % 1 bsl 31 +overflow_huge_bin_32(_) -> nomatch. + +overflow_huge_bin_skip_64(<<_:18446744073709551616/binary,0,_/binary>>) -> 1; % 1 bsl 64 +overflow_huge_bin_skip_64(<<_:144115188075855872/binary-unit:128,0,_/binary>>) -> 2; % 1 bsl 57 +overflow_huge_bin_skip_64(<<_:288230376151711744/binary-unit:64,0,_/binary>>) -> 3; % 1 bsl 58 +overflow_huge_bin_skip_64(<<_:576460752303423488/binary-unit:32,0,_/binary>>) -> 4; % 1 bsl 59 +overflow_huge_bin_skip_64(<<_:1152921504606846976/binary-unit:16,0,_/binary>>) -> 5; % 1 bsl 60 +overflow_huge_bin_skip_64(<<_:2305843009213693952/binary-unit:8,0,_/binary>>) -> 6; % 1 bsl 61 +overflow_huge_bin_skip_64(<<_:4611686018427387904/binary-unit:8,0,_/binary>>) -> 7; % 1 bsl 62 +overflow_huge_bin_skip_64(<<_:9223372036854775808/binary-unit:8,_/binary>>) -> 8; % 1 bsl 63 +overflow_huge_bin_skip_64(_) -> nomatch. + +overflow_huge_bin_64(<<Bin:18446744073709551616/binary,_/binary>>) -> {1,Bin}; % 1 bsl 64 +overflow_huge_bin_64(<<Bin:144115188075855872/binary-unit:128,0,_/binary>>) -> {2,Bin}; % 1 bsl 57 +overflow_huge_bin_64(<<Bin:288230376151711744/binary-unit:128,0,_/binary>>) -> {3,Bin}; % 1 bsl 58 +overflow_huge_bin_64(<<Bin:576460752303423488/binary-unit:128,0,_/binary>>) -> {4,Bin}; % 1 bsl 59 +overflow_huge_bin_64(<<Bin:1152921504606846976/binary-unit:128,0,_/binary>>) -> {5,Bin}; % 1 bsl 60 +overflow_huge_bin_64(<<Bin:2305843009213693952/binary-unit:128,0,_/binary>>) -> {6,Bin}; % 1 bsl 61 +overflow_huge_bin_64(<<Bin:4611686018427387904/binary-unit:128,0,_/binary>>) -> {7,Bin}; % 1 bsl 62 +overflow_huge_bin_64(<<Bin:9223372036854775808/binary-unit:128,0,_/binary>>) -> {8,Bin}; % 1 bsl 63 +overflow_huge_bin_64(_) -> nomatch. + +id(I) -> I. diff --git a/lib/hipe/test/bs_SUITE_data/bs_match_compiler.erl b/lib/hipe/test/bs_SUITE_data/bs_match_compiler.erl new file mode 100644 index 0000000000..4cb48ff57e --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_match_compiler.erl @@ -0,0 +1,1235 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% File : bs_match_compiler.erl +%%% +%%%------------------------------------------------------------------- +-module(bs_match_compiler). +-compile(nowarn_shadow_vars). + +-export([test/0]). +-export([exported_id/1, exported_id/2]). %% needed by a test + +test() -> + Funs = [fun fun_shadow/0, fun int_float/0, fun otp_5269/0, fun null_fields/0, + fun wiger/0, fun bin_tail/0, fun save_restore/0, + fun partitioned_bs_match/0, fun function_clause/0, fun unit/0, + fun shared_sub_bins/0, fun bin_and_float/0, fun dec_subidentifiers/0, + fun skip_optional_tag/0, fun wfbm/0, fun degenerated_match/0, + fun bs_sum/0, fun coverage/0, fun multiple_uses/0, fun zero_label/0, + fun followed_by_catch/0, fun matching_meets_construction/0, + fun simon/0, fun matching_and_andalso/0, + fun otp_7188/0, fun otp_7233/0, fun otp_7240/0, fun otp_7498/0, + fun match_string/0, fun zero_width/0, fun bad_size/0, fun haystack/0, + fun cover_beam_bool/0, fun matched_out_size/0, fun follow_fail_br/0, + fun no_partition/0, fun calling_a_binary/0, fun binary_in_map/0, + fun match_string_opt/0, fun map_and_binary/0, + fun unsafe_branch_caching/0], + lists:foreach(fun (F) -> ok = F() end, Funs). + + +%%-------------------------------------------------------------------- +%% OTP-5270 + +fun_shadow() -> + 7 = fun_shadow_1(), + 7 = fun_shadow_2(8), + 7 = fun_shadow_3(), + no = fun_shadow_4(8), + ok. + +fun_shadow_1() -> + L = 8, + F = fun(<<L:L,B:L>>) -> B end, + F(<<16:8, 7:16>>). + +fun_shadow_2(L) -> + F = fun(<<L:L,B:L>>) -> B end, + F(<<16:8, 7:16>>). + +fun_shadow_3() -> + L = 8, + F = fun(<<L:L,B:L,L:L>>) -> B end, + F(<<16:8, 7:16,16:16>>). + +fun_shadow_4(L) -> + F = fun(<<L:L,B:L,L:L>>) -> B; + (_) -> no end, + F(<<16:8, 7:16,15:16>>). + +%%-------------------------------------------------------------------- +%% OTP-5323 + +int_float() -> + <<103133.0:64/float>> = <<103133:64/float>>, + <<103133:64/float>> = <<103133:64/float>>, + ok. + +%%-------------------------------------------------------------------- +%% Stolen from erl_eval_SUITE and modified. +%% OTP-5269. Bugs in the bit syntax. + +otp_5269() -> + check(fun() -> L = 8, F = fun(<<A:L,B:A>>) -> B end, F(<<16:8, 7:16>>) end, 7), + check(fun() -> L = 8, <<A:L,B:A>> = <<16:8, 7:16>>, B end, 7), + check(fun() -> U = 8, (fun(<<U:U>>) -> U end)(<<32:8>>) end, 32), + check(fun() -> U = 8, [U || <<U:U>> <- [<<32:8>>]] end, [32]), + check(fun() -> [X || <<A:8, B:A>> <- [<<16:8,19:16>>], + <<X:8>> <- [<<B:8>>]] end, + [19]), + check(fun() -> A = 4, B = 28, _ = bit_size(<<13:(A+(X=B))>>), X end, 28), + check(fun() -> + <<Size,B:Size/binary,Rest/binary>> = <<2,"AB","CD">>, + {Size,B,Rest} + end, {2,<<"AB">>,<<"CD">>}), + check(fun() -> X = 32, [X || <<X:X>> <- [<<1:32>>,<<2:32>>,<<3:8>>]] end, + %% "binsize variable" ^ + [1,2]), + check(fun() -> + (fun (<<A:1/binary, B:8/integer, _C:B/binary>>) -> + case A of + B -> wrong; + _ -> ok + end + end)(<<1,2,3,4>>) end, + ok), + ok. + +%%-------------------------------------------------------------------- + +null_fields() -> + check(fun() -> + W = id(0), + F = fun(<<_:W>>) -> tail; + (<<>>) -> empty + end, + F(<<>>) + end, tail), + check(fun() -> + F = fun(<<_/binary>>) -> tail; + (<<>>) -> empty + end, + F(<<>>) + end, tail), + ok. + +%%-------------------------------------------------------------------- + +wiger() -> + ok1 = wcheck(<<3>>), + ok2 = wcheck(<<1,2,3>>), + ok3 = wcheck(<<4>>), + {error,<<1,2,3,4>>} = wcheck(<<1,2,3,4>>), + {error,<<>>} = wcheck(<<>>), + ok. + +wcheck(<<A>>) when A==3-> + ok1; +wcheck(<<_,_:2/binary>>) -> + ok2; +wcheck(<<_>>) -> + ok3; +wcheck(Other) -> + {error,Other}. + +%%-------------------------------------------------------------------- + +bin_tail() -> + S = <<"abcde">>, + $a = bin_tail_c(S, 0), + $c = bin_tail_c(S, 2), + $e = bin_tail_c(S, 4), + {'EXIT',_} = (catch bin_tail_c(S, 5)), + {'EXIT',_} = (catch bin_tail_c_var(S, 5)), + + $a = bin_tail_d(S, 0), + $b = bin_tail_d(S, 8), + $d = bin_tail_d(S, 3*8), + {'EXIT',_} = (catch bin_tail_d_dead(S, 1)), + {'EXIT',_} = (catch bin_tail_d_dead(S, 9)), + {'EXIT',_} = (catch bin_tail_d_dead(S, 5*8)), + {'EXIT',_} = (catch bin_tail_d_var(S, 1)), + + ok = bin_tail_e(<<2:2,0:1,1:5>>), + ok = bin_tail_e(<<2:2,1:1,1:5,42:64>>), + error = bin_tail_e(<<3:2,1:1,1:5,42:64>>), + error = bin_tail_e(<<>>), + ok. + +bin_tail_c(Bin, Offset) -> + Res = bin_tail_c_dead(Bin, Offset), + <<_:Offset/binary,_,Tail/binary>> = Bin, + {Res,Tail} = bin_tail_c_var(Bin, Offset), + Res. + +bin_tail_c_dead(Bin, Offset) -> + <<_:Offset/binary,C,_/binary>> = Bin, + C. + +bin_tail_c_var(Bin, Offset) -> + <<_:Offset/binary,C,Tail/binary>> = Bin, + {C,Tail}. + +bin_tail_d(Bin, BitOffset) -> + Res = bin_tail_d_dead(Bin, BitOffset), + <<_:BitOffset,_:8,Tail/binary>> = Bin, + {Res,Tail} = bin_tail_d_var(Bin, BitOffset), + Res. + +bin_tail_d_dead(Bin, BitOffset) -> + <<_:BitOffset,C,_/binary>> = Bin, + C. + +bin_tail_d_var(Bin, BitOffset) -> + <<_:BitOffset,C,Tail/binary>> = Bin, + {C,Tail}. + +bin_tail_e(Bin) -> + case bin_tail_e_dead(Bin) of + ok -> + <<_,Tail/binary>> = Bin, + Tail = bin_tail_e_var(Bin), + ok; + error -> + bin_tail_e_var(Bin) + end. + +bin_tail_e_dead(Bin) -> + case Bin of + %% The binary is aligned at the end; neither the bs_skip_bits2 nor + %% bs_test_tail2 instructions are needed. + <<2:2,_:1,1:5,_/binary>> -> ok; + _ -> error + end. + +bin_tail_e_var(Bin) -> + case Bin of + %% The binary is aligned at the end; neither the bs_skip_bits2 nor + %% bs_test_tail2 instructions are needed. + <<2:2,_:1,1:5,Tail/binary>> -> Tail; + _ -> error + end. + +%%-------------------------------------------------------------------- + +save_restore() -> + 0 = save_restore_1(<<0:2,42:6>>), + {1,3456} = save_restore_1(<<1:2,3456:14>>), + {2,7981234} = save_restore_1(<<2:2,7981234:30>>), + {3,763967493838} = save_restore_1(<<0:2,763967493838:62>>), + + A = <<" x">>, + B = <<".x">>, + C = <<"-x">>, + + {" ",<<"x">>} = lll(A), + {" ",<<"x">>} = mmm(A), + {" ",<<"x">>} = nnn(A), + {" ",<<"x">>} = ooo(A), + + {".",<<"x">>} = lll(B), + {".",<<"x">>} = mmm(B), + {".",<<"x">>} = nnn(B), + {".",<<"x">>} = ooo(B), + + {"-",<<"x">>} = lll(C), + {"-",<<"x">>} = mmm(C), + {"-",<<"x">>} = nnn(C), + {"-",<<"x">>} = ooo(C), + + Bin = <<-1:64>>, + case bad_float_unpack_match(Bin) of + -1 -> ok; + _Other -> bad_return_value_probably_NaN + end. + +save_restore_1(Bin) -> + case Bin of + <<0:2,_:6>> -> 0; + <<1:2,A:14>> -> {1,A}; + <<2:2,A:30>> -> {2,A}; + <<A:64>> -> {3,A} + end. + +lll(<<Char, Tail/binary>>) -> {[Char],Tail}. + +mmm(<<$.,$.,$., Tail/binary>>) -> Tail; +mmm(<<$\s,$-,$\s, Tail/binary>>) -> Tail; +mmm(<<Char, Tail/binary>>) -> {[Char],Tail}. %% Buggy Tail! + +nnn(<<"...", Tail/binary>>) -> Tail; +nnn(<<" - ", Tail/binary>>) -> Tail; +nnn(<<Char, Tail/binary>>) -> {[Char],Tail}. %% Buggy Tail! + +ooo(<<" - ", Tail/binary>>) -> Tail; +ooo(<<Char, Tail/binary>>) -> {[Char],Tail}. + +bad_float_unpack_match(<<F:64/float>>) -> F; +bad_float_unpack_match(<<I:64/integer-signed>>) -> I. + +%%-------------------------------------------------------------------- + +partitioned_bs_match() -> + <<1,2,3>> = partitioned_bs_match(blurf, <<42,1,2,3>>), + error = partitioned_bs_match(10, <<7,8,15,13>>), + error = partitioned_bs_match(100, {a,tuple,is,'not',a,binary}), + ok = partitioned_bs_match(0, <<>>), + fc(partitioned_bs_match, [-1,blurf], + catch partitioned_bs_match(-1, blurf)), + fc(partitioned_bs_match, [-1,<<1,2,3>>], + catch partitioned_bs_match(-1, <<1,2,3>>)), + {17,<<1,2,3>>} = partitioned_bs_match_2(1, <<17,1,2,3>>), + {7,<<1,2,3>>} = partitioned_bs_match_2(7, <<17,1,2,3>>), + + fc(partitioned_bs_match_2, [4,<<0:17>>], + catch partitioned_bs_match_2(4, <<0:17>>)), + + anything = partitioned_bs_match_3(anything, <<42>>), + ok = partitioned_bs_match_3(1, 2), + ok. + +partitioned_bs_match(_, <<42:8,T/binary>>) -> T; +partitioned_bs_match(N, _) when N > 0 -> error; +partitioned_bs_match(_, <<>>) -> ok. + +partitioned_bs_match_2(1, <<B:8,T/binary>>) -> {B,T}; +partitioned_bs_match_2(Len, <<_:8,T/binary>>) -> {Len,T}. + +partitioned_bs_match_3(Var, <<_>>) -> Var; +partitioned_bs_match_3(1, 2) -> ok. + +%%-------------------------------------------------------------------- + +function_clause() -> + ok = function_clause_1(<<0,7,0,7,42>>), + fc(function_clause_1, [<<0,1,2,3>>], + catch function_clause_1(<<0,1,2,3>>)), + fc(function_clause_1, [<<0,1,2,3>>], + catch function_clause_1(<<0,7,0,1,2,3>>)), + + ok = function_clause_2(<<0,7,0,7,42>>), + ok = function_clause_2(<<255>>), + ok = function_clause_2(<<13:4>>), + fc(function_clause_2, [<<0,1,2,3>>], + catch function_clause_2(<<0,1,2,3>>)), + fc(function_clause_2, [<<0,1,2,3>>], + catch function_clause_2(<<0,7,0,1,2,3>>)), + ok. + +function_clause_1(<<0:8,7:8,T/binary>>) -> + function_clause_1(T); +function_clause_1(<<_:8>>) -> + ok. + +function_clause_2(<<0:8,7:8,T/binary>>) -> + function_clause_2(T); +function_clause_2(<<_:8>>) -> + ok; +function_clause_2(<<_:4>>) -> + ok. + +%%-------------------------------------------------------------------- + +unit() -> + 42 = peek1(<<42>>), + 43 = peek1(<<43,1,2>>), + 43 = peek1(<<43,1,2,(-1):1>>), + 43 = peek1(<<43,1,2,(-1):2>>), + 43 = peek1(<<43,1,2,(-1):7>>), + + 99 = peek8(<<99>>), + 100 = peek8(<<100,101>>), + fc(peek8, [<<100,101,0:1>>], catch peek8(<<100,101,0:1>>)), + + 37484 = peek16(<<37484:16>>), + 37489 = peek16(<<37489:16,5566:16>>), + fc(peek16, [<<8>>], catch peek16(<<8>>)), + fc(peek16, [<<42:15>>], catch peek16(<<42:15>>)), + fc(peek16, [<<1,2,3,4,5>>], catch peek16(<<1,2,3,4,5>>)), + + 127 = peek7(<<127:7>>), + 100 = peek7(<<100:7,19:7>>), + fc(peek7, [<<1,2>>], catch peek7(<<1,2>>)), + ok. + +peek1(<<B:8,_/bitstring>>) -> B. + +peek7(<<B:7,_/binary-unit:7>>) -> B. + +peek8(<<B:8,_/binary>>) -> B. + +peek16(<<B:16,_/binary-unit:16>>) -> B. + +%%-------------------------------------------------------------------- + +shared_sub_bins() -> + {15,[<<>>,<<5>>,<<4,5>>,<<3,4,5>>,<<2,3,4,5>>]} = sum(<<1,2,3,4,5>>, [], 0), + ok. + +sum(<<B,T/binary>>, Acc, Sum) -> + sum(T, [T|Acc], Sum+B); +sum(<<>>, Last, Sum) -> {Sum,Last}. + +%%-------------------------------------------------------------------- + +bin_and_float() -> + 14.0 = bin_and_float(<<1.0/float,2.0/float,3.0/float>>, 0.0), + ok. + +bin_and_float(<<X/float,Y/float,Z/float,T/binary>>, Sum) when is_float(X), + is_float(Y), + is_float(Z) -> + bin_and_float(T, Sum+X*X+Y*Y+Z*Z); +bin_and_float(<<>>, Sum) -> Sum. + +%%-------------------------------------------------------------------- + +dec_subidentifiers() -> + {[],<<1,2,3>>} = + do_dec_subidentifiers(<<1:1,42:7,1:1,99:7,1,2,3>>, 0, [], 2), + {[5389],<<1,2,3>>} = + do_dec_subidentifiers(<<1:1,42:7,0:1,13:7,1,2,3>>, 0, [], 2), + {[3,2,1],not_a_binary} = dec_subidentifiers(not_a_binary, any, [1,2,3], 0), + ok. + +do_dec_subidentifiers(Buffer, Av, Al, Len) -> + Res = dec_subidentifiers(Buffer, Av, Al, Len), + Res = dec_subidentifiers2(Buffer, Av, Al, Len), + Res = dec_subidentifiers4(Buffer, Av, Al, Len), + Res = dec_subidentifiers3(Buffer, Av, Al, Len). + +dec_subidentifiers(Buffer, _Av, Al, 0) -> + {lists:reverse(Al),Buffer}; +dec_subidentifiers(<<1:1,H:7,T/binary>>, Av, Al, Len) -> + dec_subidentifiers(T, (Av bsl 7) bor H, Al, Len-1); +dec_subidentifiers(<<H,T/binary>>, Av, Al, Len) -> + dec_subidentifiers(T, 0, [((Av bsl 7) bor H)|Al], Len-1). + +dec_subidentifiers2(<<Buffer/binary>>, _Av, Al, 0) -> + {lists:reverse(Al),Buffer}; +dec_subidentifiers2(<<1:1,H:7,T/binary>>, Av, Al, Len) -> + dec_subidentifiers2(T, (Av bsl 7) bor H, Al, Len-1); +dec_subidentifiers2(<<H,T/binary>>, Av, Al, Len) -> + dec_subidentifiers2(T, 0, [((Av bsl 7) bor H)|Al], Len-1). + +dec_subidentifiers3(Buffer, _Av, Al, 0) when is_binary(Buffer) -> + {lists:reverse(Al),Buffer}; +dec_subidentifiers3(<<1:1,H:7,T/binary>>, Av, Al, Len) -> + dec_subidentifiers3(T, (Av bsl 7) bor H, Al, Len-1); +dec_subidentifiers3(<<H,T/binary>>, Av, Al, Len) -> + dec_subidentifiers3(T, 0, [((Av bsl 7) bor H)|Al], Len-1). + +dec_subidentifiers4(<<1:1,H:7,T/binary>>, Av, Al, Len) when Len =/= 0 -> + dec_subidentifiers4(T, (Av bsl 7) bor H, Al, Len-1); +dec_subidentifiers4(<<H,T/binary>>, Av, Al, Len) when Len =/= 0 -> + dec_subidentifiers4(T, 0, [((Av bsl 7) bor H)|Al], Len-1); +dec_subidentifiers4(Buffer, _Av, Al, 0) -> + {lists:reverse(Al),Buffer}. + +%%-------------------------------------------------------------------- + +skip_optional_tag() -> + {ok,<<>>} = skip_optional_tag(<<42>>, <<42>>), + {ok,<<>>} = skip_optional_tag(<<42,1>>, <<42,1>>), + {ok,<<1,2,3>>} = skip_optional_tag(<<42>>, <<42,1,2,3>>), + missing = skip_optional_tag(<<2:3>>, blurf), + ok. + +skip_optional_tag(<<>>, Binary) -> + {ok,Binary}; +skip_optional_tag(<<Tag,RestTag/binary>>, <<Tag,Rest/binary>>) -> + skip_optional_tag(RestTag, Rest); +skip_optional_tag(_, _) -> missing. + +%%-------------------------------------------------------------------- + +-define(DATELEN, 16). + +wfbm() -> + %% check_for_dot_or_space and get_tail is from wfbm4 by Steve Vinoski, + %% with modifications. + {nomatch,0} = check_for_dot_or_space(<<" ">>), + {nomatch,0} = check_for_dot_or_space(<<" abc">>), + {ok,<<"abcde">>} = check_for_dot_or_space(<<"abcde 34555">>), + {nomatch,0} = check_for_dot_or_space(<<".gurka">>), + {nomatch,1} = check_for_dot_or_space(<<"g.urka">>), + nomatch = get_tail(<<>>), + {ok,<<"2007/10/23/blurf">>} = get_tail(<<"200x/2007/10/23/blurf ">>), + {skip,?DATELEN+5} = get_tail(<<"200x/2007/10/23/blurf.">>), + nomatch = get_tail(<<"200y.2007.10.23.blurf ">>), + {'EXIT',_} = (catch get_tail({no,binary,at,all})), + {'EXIT',_} = (catch get_tail(no_binary)), + ok. + +check_for_dot_or_space(Bin) -> + check_for_dot_or_space(Bin, 0). + +check_for_dot_or_space(<<$\s, _/binary>>, 0) -> + {nomatch,0}; +check_for_dot_or_space(Bin, Len) -> + case Bin of + <<Front:Len/binary, $\s, _/binary>> -> + {ok,Front}; + <<_:Len/binary, $., _/binary>> -> + {nomatch,Len}; + _ -> + check_for_dot_or_space(Bin, Len+1) + end. + +get_tail(<<>>) -> + nomatch; +get_tail(Bin) -> + <<Front:?DATELEN/binary, Tail/binary>> = Bin, + case Front of + <<_:3/binary,"x/",Y:4/binary,$/,M:2/binary,$/,D:2/binary,$/>> -> + case check_for_dot_or_space(Tail) of + {ok,Match} -> + {ok,<<Y/binary,$/,M/binary,$/,D/binary,$/, Match/binary>>}; + {nomatch,Skip} -> {skip,?DATELEN + Skip} + end; + _ -> nomatch + end. + +%%-------------------------------------------------------------------- + +degenerated_match() -> + error = degenerated_match_1(<<>>), + 1 = degenerated_match_1(<<1:1>>), + 2 = degenerated_match_1(<<42,43>>), + + error = degenerated_match_2(<<>>), + no_split = degenerated_match_2(<<1,2>>), + {<<1,2,3,4>>,<<5>>} = degenerated_match_2(<<1,2,3,4,5>>), + ok. + +degenerated_match_1(<<>>) -> error; +degenerated_match_1(Bin) -> byte_size(Bin). + +degenerated_match_2(<<>>) -> error; +degenerated_match_2(Bin) -> + case byte_size(Bin) > 4 of + true -> split_binary(Bin, 4); + false -> no_split + end. + +%%-------------------------------------------------------------------- + +bs_sum() -> + 0 = bs_sum_1([]), + 0 = bs_sum_1(<<>>), + 42 = bs_sum_1([42]), + 1 = bs_sum_1(<<1>>), + 10 = bs_sum_1([1,2,3,4]), + 15 = bs_sum_1(<<1,2,3,4,5>>), + 21 = bs_sum_1([1,2,3|<<4,5,6>>]), + 15 = bs_sum_1([1,2,3|{4,5}]), + 6 = bs_sum_1([1,2,3|zero]), + 6 = bs_sum_1([1,2,3|0]), + 7 = bs_sum_1([1,2,3|one]), + + fc(catch bs_sum_1({too,big,tuple})), + fc(catch bs_sum_1([1,2,3|{too,big,tuple}])), + + [] = sneaky_alias(<<>>), + [559,387655] = sneaky_alias(id(<<559:32,387655:32>>)), + fc(sneaky_alias, [<<1>>], catch sneaky_alias(id(<<1>>))), + fc(sneaky_alias, [[1,2,3,4]], catch sneaky_alias(lists:seq(1, 4))), + ok. + +bs_sum_1(<<H,T/binary>>) -> H+bs_sum_1(T); +bs_sum_1([H|T]) -> H+bs_sum_1(T); +bs_sum_1({A,B}=_Tuple=_AliasForNoGoodReason) -> A+B; +bs_sum_1(0) -> 0; +bs_sum_1(zero=_Zero) -> 0; +bs_sum_1(one) -> 1; +bs_sum_1([]) -> 0; +bs_sum_1(<<>>) -> 0. + +sneaky_alias(<<>>=L) -> binary_to_list(L); +sneaky_alias(<<From:32,L/binary>>) -> [From|sneaky_alias(L)]. + +%%-------------------------------------------------------------------- + +coverage() -> + 0 = coverage_fold(fun(B, A) -> A+B end, 0, <<>>), + 6 = coverage_fold(fun(B, A) -> A+B end, 0, <<1,2,3>>), + fc(catch coverage_fold(fun(B, A) -> A+B end, 0, [a,b,c])), + + {<<42.0:64/float>>,float} = coverage_build(<<>>, <<42>>, float), + {<<>>,not_a_tuple} = coverage_build(<<>>, <<>>, not_a_tuple), + {<<16#76,"abc",16#A9,"abc">>,{x,42,43}} = + coverage_build(<<>>, <<16#7,16#A>>, {x,y,z}), + + [<<2>>,<<1>>] = coverage_bc(<<1,2>>, []), + + {x,<<"abc">>,z} = coverage_setelement(<<2,"abc">>, {x,y,z}), + + [42] = coverage_apply(<<42>>, [exported_id]), + 42 = coverage_external(<<42>>), + + do_coverage_bin_to_term_list([]), + do_coverage_bin_to_term_list([lists:seq(0, 10),{a,b,c},<<23:42>>]), + fc(coverage_bin_to_term_list, [<<0,0,0,7>>], + catch do_coverage_bin_to_term_list_1(<<7:32>>)), + + <<>> = coverage_per_key(<<4:32>>), + <<$a,$b,$c>> = coverage_per_key(<<7:32,"abc">>), + + ok. + +coverage_fold(Fun, Acc, <<H,T/binary>>) -> + IdFun = fun id/1, + coverage_fold(Fun, Fun(IdFun(H), IdFun(Acc)), T); +coverage_fold(Fun, Acc, <<>>) when is_function(Fun, 2) -> Acc. + +coverage_build(Acc0, <<H,T/binary>>, float) -> + Float = id(<<H:64/float>>), + Acc = <<Acc0/binary,Float/binary>>, + coverage_build(Acc, T, float); +coverage_build(Acc0, <<H,T/binary>>, Tuple0) -> + Str = id(<<H:(id(4)),(H-1):4,"abc">>), + Acc = id(<<Acc0/bitstring,Str/bitstring>>), + Tuple = setelement(2, setelement(3, Tuple0, 43), 42), + if + byte_size(Acc) > 0 -> + coverage_build(Acc, T, Tuple) + end; +coverage_build(Acc, <<>>, Tuple) -> {Acc,Tuple}. + +coverage_bc(<<H,T/binary>>, Acc) -> + B = << <<C:8>> || C <- [H] >>, + coverage_bc(T, [B|Acc]); +coverage_bc(<<>>, Acc) -> Acc. + +coverage_setelement(<<H,T1/binary>>, Tuple) when element(1, Tuple) =:= x -> + setelement(H, Tuple, T1). + +coverage_apply(<<H,T/binary>>, [F|Fs]) -> + [?MODULE:F(H)|coverage_apply(T, Fs)]; +coverage_apply(<<>>, []) -> []. + +coverage_external(<<H,T/binary>>) -> + ?MODULE:exported_id(T, T), + H. + +exported_id(I) -> id(I). + +exported_id(_, _) -> ok. + +do_coverage_bin_to_term_list(L) -> + Bin = << <<(begin BinTerm = term_to_binary(Term), + <<(byte_size(BinTerm)):32,BinTerm/binary>> end)/binary>> || + Term <- L >>, + L = do_coverage_bin_to_term_list_1(Bin), + L = do_coverage_bin_to_term_list_1(<<Bin/binary,7:32,"garbage">>), + L = do_coverage_bin_to_term_list_1(<<7:32,"garbage",Bin/binary>>). + +do_coverage_bin_to_term_list_1(Bin) -> + Res = coverage_bin_to_term_list(Bin), + Res = coverage_bin_to_term_list(Bin, []), + Res = coverage_bin_to_term_list_catch(Bin), + Res = coverage_bin_to_term_list_catch(Bin, []). + +coverage_bin_to_term_list(<<Sz:32,BinTerm:Sz/binary,T/binary>>) -> + try binary_to_term(BinTerm) of + Term -> [Term|coverage_bin_to_term_list(T)] + catch + error:badarg -> coverage_bin_to_term_list(T) + end; +coverage_bin_to_term_list(<<>>) -> []. + +coverage_bin_to_term_list(<<Sz:32,BinTerm:Sz/binary,T/binary>>, Acc) -> + try binary_to_term(BinTerm) of + Term -> coverage_bin_to_term_list(T, [Term|Acc]) + catch + error:badarg -> coverage_bin_to_term_list(T, Acc) + end; +coverage_bin_to_term_list(<<>>, Acc) -> lists:reverse(Acc). + +coverage_bin_to_term_list_catch(<<Sz:32,BinTerm:Sz/binary,T/binary>>) -> + case catch binary_to_term(BinTerm) of + {'EXIT',_} -> coverage_bin_to_term_list_catch(T); + Term -> [Term|coverage_bin_to_term_list_catch(T)] + end; +coverage_bin_to_term_list_catch(<<>>) -> []. + +coverage_bin_to_term_list_catch(<<Sz:32,BinTerm:Sz/binary,T/binary>>, Acc) -> + case catch binary_to_term(BinTerm) of + {'EXIT',_} -> coverage_bin_to_term_list_catch(T, Acc); + Term -> coverage_bin_to_term_list_catch(T, [Term|Acc]) + end; +coverage_bin_to_term_list_catch(<<>>, Acc) -> lists:reverse(Acc). + +coverage_per_key(<<BinSize:32,Bin/binary>> = B) -> + true = (byte_size(B) =:= BinSize), + Bin. + +%%-------------------------------------------------------------------- + +multiple_uses() -> + {344,62879,345,<<245,159,1,89>>} = multiple_uses_1(<<1,88,245,159,1,89>>), + true = multiple_uses_2(<<0,0,197,18>>), + <<42,43>> = multiple_uses_3(<<0,0,42,43>>, fun id/1), + ok. + +multiple_uses_1(<<X:16,Tail/binary>>) -> + %% NOT OPTIMIZED: sub binary is matched or used in more than one place + {Y,Z} = multiple_uses_match(Tail), + {X,Y,Z,Tail}. + +multiple_uses_2(<<_:16,Tail/binary>>) -> + %% NOT OPTIMIZED: sub binary is matched or used in more than one place + multiple_uses_cmp(Tail, Tail). + +multiple_uses_3(<<_:16,Tail/binary>>, Fun) -> + %% NOT OPTIMIZED: sub binary is used or returned + Fun(Tail). + +multiple_uses_match(<<Y:16,Z:16>>) -> {Y,Z}. + +multiple_uses_cmp(<<Y:16>>, <<Y:16>>) -> true; +multiple_uses_cmp(<<_:16>>, <<_:16>>) -> false. + +%%-------------------------------------------------------------------- + +zero_label() -> + <<"nosemouth">> = read_pols(<<"FACE","nose","mouth">>), + <<"CE">> = read_pols(<<"noFACE">>), + ok. + +read_pols(Data) -> + <<PolygonType:4/binary,Rest/binary>> = Data, + %% Intentional warning. + _ = (PolygonType == <<"FACE">>) or (PolygonType == <<"PTCH">>), + Rest. + +%%-------------------------------------------------------------------- + +followed_by_catch() -> + ok = handle(<<0,1,2,3,4,5>>). + +-record(rec,{field}). +handle(<<>>) -> ok; +handle(Msg) -> + <<_DataLen:16, Rest/binary>> = Msg, + case catch fooX:func() of + [X] -> + X#rec.field; + _ -> + ok + end, + handle(Rest). + +%%-------------------------------------------------------------------- + +matching_meets_construction() -> + Bin = id(<<"abc">>), + Len = id(2), + Tail0 = id(<<1,2,3,4,5>>), + <<_:Len/binary,Tail/binary>> = Tail0, + Res = <<Tail/binary,Bin/binary>>, + <<3,4,5,"abc">> = Res, + {'EXIT',{badarg,_}} = (catch matching_meets_construction_1(<<"Abc">>)), + {'EXIT',{badarg,_}} = (catch matching_meets_construction_2(<<"Abc">>)), + <<"Bbc">> = matching_meets_construction_3(<<"Abc">>), + <<1,2>> = encode_octet_string(<<1,2,3>>, 2), + ok. + +matching_meets_construction_1(<<"A",H/binary>>) -> <<"B",H>>. + +matching_meets_construction_2(<<"A",H/binary>>) -> <<"B",H/float>>. + +matching_meets_construction_3(<<"A",H/binary>>) -> <<"B",H/binary>>. + +encode_octet_string(<<OctetString/binary>>, Len) -> + <<OctetString:Len/binary-unit:8>>. + +%%-------------------------------------------------------------------- + +simon() -> + one = simon(blurf, <<>>), + two = simon(0, <<42>>), + fc(simon, [17,<<1>>], catch simon(17, <<1>>)), + fc(simon, [0,<<1,2,3>>], catch simon(0, <<1,2,3>>)), + + one = simon2(blurf, <<9>>), + two = simon2(0, <<9,1>>), + fc(simon2, [0,<<9,10,11>>], catch simon2(0, <<9,10,11>>)), + ok. + +simon(_, <<>>) -> one; +simon(0, <<_>>) -> two. + +simon2(_, <<9>>) -> one; +simon2(0, <<_:16>>) -> two. + +%%-------------------------------------------------------------------- +%% OTP-7113: Crash in v3_codegen. + +matching_and_andalso() -> + ok = matching_and_andalso_1(<<1,2,3>>, 3), + {'EXIT',{function_clause,_}} = (catch matching_and_andalso_1(<<1,2,3>>, -8)), + {'EXIT',{function_clause,_}} = (catch matching_and_andalso_1(<<1,2,3>>, blurf)), + {'EXIT',{function_clause,_}} = (catch matching_and_andalso_1(<<1,2,3>>, 19)), + + {"abc",<<"xyz">>} = matching_and_andalso_2("abc", <<"-xyz">>), + {"abc",<<"">>} = matching_and_andalso_2("abc", <<($a-1)>>), + {"abc",<<"">>} = matching_and_andalso_2("abc", <<($z+1)>>), + {"abc",<<"">>} = matching_and_andalso_2("abc", <<($A-1)>>), + {"abc",<<"">>} = matching_and_andalso_2("abc", <<($Z+1)>>), + error = matching_and_andalso_2([], <<>>), + error = matching_and_andalso_2([], <<$A>>), + error = matching_and_andalso_2([], <<$Z>>), + error = matching_and_andalso_2([], <<$a>>), + error = matching_and_andalso_2([], <<$z>>), + ok. + +matching_and_andalso_1(<<Bitmap/binary>>, K) + when is_integer(K) andalso size(Bitmap) >= K andalso 0 < K -> ok. + +matching_and_andalso_2(Datetime, <<H,T/binary>>) + when not ((H >= $a) andalso (H =< $z)) andalso + not ((H >= $A) andalso (H =< $Z)) -> + {Datetime,T}; +matching_and_andalso_2(_, _) -> error. + +%%-------------------------------------------------------------------- +%% Thanks to Tomas Stejskal. + +otp_7188() -> + MP3 = <<84,65,71,68,117,154,105,232,107,121,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,0,0,0,0,0,0,0,68,97,110,105,101,108,32,76, + 97,110,100,97,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,66, + 101,115,116,32,79,102,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0, + 0,0,0,0,0,0,50,48,48,48,50,48,48,48,32,45,32,66,101,115, + 116,32,79,102,32,32,32,32,32,32,32,32,32,32,32,32,32,32, + 32,32,12>>, + {ok,{"ID3v1", + [{title,<<68,117,154,105,232,107,121>>}, + {artist,<<"Daniel Landa">>}, + {album,<<"Best Of">>}]}} = parse_v1_or_v11_tag(MP3), + ok. + +parse_v1_or_v11_tag(<<"TAG", Title:30/binary, + Artist:30/binary, Album:30/binary, + _Year:4/binary, _Comment:28/binary, + 0:8, Track:8, _Genre:8>>) -> + {ok, + {"ID3v1.1", + [{track, Track}, {title, trim(Title)}, + {artist, trim(Artist)}, {album, trim(Album)}]}}; +parse_v1_or_v11_tag(<<"TAG", Title:30/binary, + Artist:30/binary, Album:30/binary, + _Year:4/binary, _Comment:30/binary, + _Genre:8>>) -> + {ok, + {"ID3v1", + [{title, trim(Title)}, + {artist, trim(Artist)}, + {album, trim(Album)}]}}; +parse_v1_or_v11_tag(_) -> + error. + +trim(Bin) -> + list_to_binary(trim_blanks(binary_to_list(Bin))). + +trim_blanks(L) -> + lists:reverse(skip_blanks_and_zero(lists:reverse(L))). + +skip_blanks_and_zero([$\s|T]) -> + skip_blanks_and_zero(T); +skip_blanks_and_zero([0|T]) -> + skip_blanks_and_zero(T); +skip_blanks_and_zero(L) -> + L. + +%%-------------------------------------------------------------------- +%% OTP-7233. Record and binary matching optimizations clashed. +%% Thanks to Vladimir Klebansky. + +-record(rec_otp_7233, {key, val}). + +otp_7233() -> + otp_7233_1(#rec_otp_7233{key = <<"XXabcde">>,val=[{"xxxxxxxx",42}]}), + [<<"XXabcde">>,{"xxxxxxxx",42}] = get(io_format), + erase(io_format), + otp_7233_1(#rec_otp_7233{key = <<"XXabcde">>,val=[]}), + undefined = get(io_format), + ok. + +otp_7233_1(Rec) -> + <<K:2/binary,_Rest:5/binary>> = Rec#rec_otp_7233.key, + case K of + <<"XX">> -> + Value = Rec#rec_otp_7233.val, + case lists:keysearch("xxxxxxxx", 1, Value) of + {value,T} -> put(io_format, [Rec#rec_otp_7233.key,T]); + false -> ok + end; + _ -> ok + end. + +%%-------------------------------------------------------------------- + +otp_7240() -> + a = otp_7240_a(0, <<>>), + b = otp_7240_a(1, 2), + + a = otp_7240_b(anything, <<>>), + b = otp_7240_b(1, {x,y}), + + a = otp_7240_c(anything, <<>>), + b = otp_7240_c(1, <<2>>), + + a = otp_7240_d(anything, <<>>), + b = otp_7240_d(again, <<2>>), + + a = otp_7240_e(anything, <<>>), + b = otp_7240_e(1, 41), + + a = otp_7240_f(anything, <<>>), + b = otp_7240_f(1, {}), + + ok. + +otp_7240_a(_, <<>>) -> a; +otp_7240_a(1, 2) -> b. + +otp_7240_b(_, <<>>) -> a; +otp_7240_b(1, {_,_}) -> b. + +otp_7240_c(_, <<>>) -> a; +otp_7240_c(1, <<2>>) -> b. + +otp_7240_d(_, <<>>) -> a; +otp_7240_d(_, <<2>>) -> b. + +otp_7240_e(_, <<>>) -> a; +otp_7240_e(1, B) when B < 42 -> b. + +otp_7240_f(_, <<>>) -> a; +otp_7240_f(1, B) when is_tuple(B) -> b. + +%%-------------------------------------------------------------------- + +otp_7498() -> + <<1,2,3>> = otp_7498_foo(<<1,2,3>>, 0), + <<2,3>> = otp_7498_foo(<<1,2,3>>, 1), + <<1,2,3>> = otp_7498_foo(<<1,2,3>>, 2), + + <<1,2,3>> = otp_7498_bar(<<1,2,3>>, 0), + <<2,3>> = otp_7498_bar(<<1,2,3>>, 1), + <<1,2,3>> = otp_7498_bar(<<1,2,3>>, 2), + <<>> = otp_7498_bar(<<>>, 2), + <<1,2,3>> = otp_7498_bar(<<1,2,3>>, 3), + ok. + +otp_7498_foo(Bin, 0) -> + otp_7498_foo(Bin, 42); +otp_7498_foo(<<_A, Rest/bitstring>>, 1) -> + otp_7498_foo(Rest, 43); +otp_7498_foo(Bin, _I) -> + Bin. + +otp_7498_bar(Bin, 0) -> + otp_7498_bar(Bin, 42); +otp_7498_bar(<<_A, Rest/bitstring>>, 1) -> + otp_7498_bar(Rest, 43); +otp_7498_bar(<<>>, 2) -> + otp_7498_bar(<<>>, 44); +otp_7498_bar(Bin, _I) -> + Bin. + +%%-------------------------------------------------------------------- + +match_string() -> + %% To make sure that native endian really is handled correctly + %% (i.e. that the compiler does not attempt to use bs_match_string/4 + %% instructions for native segments), running this test is not enough. + %% Either examine the generated for do_match_string_native/1 or + %% check the coverage for the v3_kernel module. + case erlang:system_info(endian) of + little -> + do_match_string_native(<<$a,0,$b,0>>); + big -> + do_match_string_native(<<0,$a,0,$b>>) + end, + do_match_string_big(<<0,$a,0,$b>>), + do_match_string_little(<<$a,0,$b,0>>), + + do_match_string_big_signed(<<255,255>>), + do_match_string_little_signed(<<255,255>>), + + plain = no_match_string_opt(<<"abc">>), + strange = no_match_string_opt(<<$a:9,$b:9,$c:9>>), + ok. + +do_match_string_native(<<$a:16/native,$b:16/native>>) -> ok. + +do_match_string_big(<<$a:16/big,$b:16/big>>) -> ok. + +do_match_string_little(<<$a:16/little,$b:16/little>>) -> ok. + +do_match_string_big_signed(<<(-1):16/signed>>) -> ok. + +do_match_string_little_signed(<<(-1):16/little-signed>>) -> ok. + +no_match_string_opt(<<"abc">>) -> plain; +no_match_string_opt(<<$a:9,$b:9,$c:9>>) -> strange. + +%%-------------------------------------------------------------------- +%% OTP-7591: A zero-width segment in matching would crash the compiler. + +zero_width() -> + <<Len:16/little, Str:Len/binary, 0:0>> = <<2, 0, $h, $i, 0:0>>, + 2 = Len, + Str = <<"hi">>, + %% Match sure that values that cannot fit in a segment will not match. + case id(<<0:8>>) of + <<256:8>> -> error; + _ -> ok + end. + +%%-------------------------------------------------------------------- +%% OTP_7650: A invalid size for binary segments could crash the compiler. + +bad_size() -> + Tuple = {a,b,c}, + {'EXIT',{{badmatch,<<>>},_}} = (catch <<32:Tuple>> = id(<<>>)), + Binary = <<1,2,3>>, + {'EXIT',{{badmatch,<<>>},_}} = (catch <<32:Binary>> = id(<<>>)), + ok. + +%%-------------------------------------------------------------------- + +haystack() -> + <<0:10/unit:8>> = haystack_1(<<0:10/unit:8>>), + [<<0:10/unit:8>>, + <<0:20/unit:8>>] = haystack_2(<<1:8192>>), + ok. + +%% Used to crash the compiler. +haystack_1(Haystack) -> + Subs = [10], + [begin + <<B:Y/binary>> = Haystack, + B + end || Y <- Subs], + Haystack. + +%% There would be an incorrect badmatch exception. +haystack_2(Haystack) -> + Subs = [{687,10},{369,20}], + [begin + <<_:X/binary,B:Y/binary,_/binary>> = Haystack, + B + end || {X,Y} <- Subs]. + +fc({'EXIT',{function_clause,_}}) -> ok. + +fc(Name, Args, {'EXIT',{function_clause,[{?MODULE,Name,Args,_}|_]}}) -> ok; +fc(Name, Args, {'EXIT',{function_clause,[{?MODULE,Name,Arity,_}|_]}}) + when length(Args) =:= Arity -> + true = test_server:is_native(?MODULE). + +%%-------------------------------------------------------------------- +%% Cover the clause handling bs_context to binary in +%% beam_block:initialized_regs/2. +cover_beam_bool() -> + ok = do_cover_beam_bool(<<>>, 3), + <<19>> = do_cover_beam_bool(<<19>>, 2), + <<42>> = do_cover_beam_bool(<<42>>, 1), + <<17>> = do_cover_beam_bool(<<13,17>>, 0), + ok. + +do_cover_beam_bool(Bin, X) when X > 0 -> + if + X =:= 1; X =:= 2 -> + Bin; + true -> + ok + end; +do_cover_beam_bool(<<_,Bin/binary>>, X) -> + do_cover_beam_bool(Bin, X+1). + +%%-------------------------------------------------------------------- + +matched_out_size() -> + {253,16#DEADBEEF} = mos_int(<<8,253,16#DEADBEEF:32>>), + {6,16#BEEFDEAD} = mos_int(<<3,6:3,16#BEEFDEAD:32>>), + {53,16#CAFEDEADBEEFCAFE} = mos_int(<<16,53:16,16#CAFEDEADBEEFCAFE:64>>), + {23,16#CAFEDEADBEEFCAFE} = mos_int(<<5,23:5,16#CAFEDEADBEEFCAFE:64>>), + + {<<1,2,3>>,4} = mos_bin(<<3,1,2,3,4,3>>), + {<<1,2,3,7>>,19,42} = mos_bin(<<4,1,2,3,7,19,4,42>>), + <<1,2,3,7>> = mos_bin(<<4,1,2,3,7,"abcdefghij">>), + ok. + +mos_int(<<L,I:L,X:32>>) -> + {I,X}; +mos_int(<<L,I:L,X:64>>) -> + {I,X}. + +mos_bin(<<L,Bin:L/binary,X:8,L>>) -> + L = byte_size(Bin), + {Bin,X}; +mos_bin(<<L,Bin:L/binary,X:8,L,Y:8>>) -> + L = byte_size(Bin), + {Bin,X,Y}; +mos_bin(<<L,Bin:L/binary,"abcdefghij">>) -> + L = byte_size(Bin), + Bin. + +%%-------------------------------------------------------------------- + +follow_fail_br() -> + 42 = ffb_1(<<0,1>>, <<0>>), + 8 = ffb_1(<<0,1>>, [a]), + 42 = ffb_2(<<0,1>>, <<0>>, 17), + 8 = ffb_2(<<0,1>>, [a], 0), + ok. + +ffb_1(<<_,T/bitstring>>, List) -> + case List of + <<_>> -> + 42; + [_|_] -> + %% The fail branch of the bs_start_match2 instruction pointing + %% to here would be ignored, making the compiler incorrectly + %% assume that the delayed sub-binary optimization was safe. + bit_size(T) + end. + +ffb_2(<<_,T/bitstring>>, List, A) -> + case List of + <<_>> when A =:= 17 -> 42; + [_|_] -> bit_size(T) + end. + +%%-------------------------------------------------------------------- + +no_partition() -> + one = no_partition_1(<<"string">>, a1), + {two,<<"string">>} = no_partition_1(<<"string">>, a2), + {two,<<>>} = no_partition_1(<<>>, a2), + {two,a} = no_partition_1(a, a2), + three = no_partition_1(undefined, a3), + {four,a,[]} = no_partition_1([a], a4), + {five,a,b} = no_partition_1({a,b}, a5), + + one = no_partition_2(<<"string">>, a1), + two = no_partition_2(<<"string">>, a2), + two = no_partition_2(<<>>, a2), + two = no_partition_2(a, a2), + three = no_partition_2(undefined, a3), + four = no_partition_2(42, a4), + five = no_partition_2([], a5), + six = no_partition_2(42.0, a6), + ok. + +no_partition_1(<<"string">>, a1) -> one; +no_partition_1(V, a2) -> {two,V}; +no_partition_1(undefined, a3) -> three; +no_partition_1([H|T], a4) -> {four,H,T}; +no_partition_1({A,B}, a5) -> {five,A,B}. + +no_partition_2(<<"string">>, a1) -> one; +no_partition_2(_, a2) -> two; +no_partition_2(undefined, a3) -> three; +no_partition_2(42, a4) -> four; +no_partition_2([], a5) -> five; +no_partition_2(42.0, a6) -> six. + +%%-------------------------------------------------------------------- + +calling_a_binary() -> + [] = call_binary(<<>>, []), + {'EXIT',{badarg,_}} = (catch call_binary(<<1>>, [])), + {'EXIT',{badarg,_}} = (catch call_binary(<<1,2,3>>, [])), + ok. + +call_binary(<<>>, Acc) -> + Acc; +call_binary(<<H,T/bits>>, Acc) -> + T(<<Acc/binary,H>>). + +%%-------------------------------------------------------------------- + +binary_in_map() -> + ok = match_binary_in_map(#{key => <<42:8>>}), + {'EXIT',{{badmatch,#{key := 1}},_}} = + (catch match_binary_in_map(#{key => 1})), + {'EXIT',{{badmatch,#{key := <<1023:16>>}},_}} = + (catch match_binary_in_map(#{key => <<1023:16>>})), + {'EXIT',{{badmatch,#{key := <<1:8>>}},_}} = + (catch match_binary_in_map(#{key => <<1:8>>})), + {'EXIT',{{badmatch,not_a_map},_}} = + (catch match_binary_in_map(not_a_map)), + ok. + +match_binary_in_map(Map) -> + case 8 of + N -> + #{key := <<42:N>>} = Map, + ok + end. + +%%-------------------------------------------------------------------- + +match_string_opt() -> + {x,<<1,2,3>>,{<<1>>,{v,<<1,2,3>>}}} = match_string_opt({<<1>>,{v,<<1,2,3>>}}), + ok. + +match_string_opt({<<1>>,{v,V}}=T) -> + {x,V,T}. + +%%-------------------------------------------------------------------- +%% If 'bin_opt_info' was given the warning would lack filename and +%% line number. + +map_and_binary() -> + {<<"10">>,<<"37">>,<<"am">>} = do_map_and_binary(<<"10:37am">>), + Map1 = #{time => "noon"}, + {ok,Map1} = do_map_and_binary(Map1), + Map2 = #{hour => 8, min => 42}, + {8,42,Map2} = do_map_and_binary(Map2), + ok. + +do_map_and_binary(<<Hour:2/bytes, $:, Min:2/bytes, Rest/binary>>) -> + {Hour, Min, Rest}; +do_map_and_binary(#{time := _} = T) -> + {ok, T}; +do_map_and_binary(#{hour := Hour, min := Min} = T) -> + {Hour, Min, T}. + +%%-------------------------------------------------------------------- +%% Unsafe caching of branch outcomes in beam_bsm would cause the +%% delayed creation of sub-binaries optimization to be applied even +%% when it was unsafe. + +unsafe_branch_caching() -> + <<>> = do_unsafe_branch_caching(<<42,1>>), + <<>> = do_unsafe_branch_caching(<<42,2>>), + <<>> = do_unsafe_branch_caching(<<42,3>>), + <<17,18>> = do_unsafe_branch_caching(<<42,3,17,18>>), + <<>> = do_unsafe_branch_caching(<<1,3,42,2>>), + ok. + +do_unsafe_branch_caching(<<Code/integer, Bin/binary>>) -> + <<C1/integer, B1/binary>> = Bin, + case C1 of + X when X =:= 1 orelse X =:= 2 -> + Bin2 = <<>>; + _ -> + Bin2 = B1 + end, + case Code of + 1 -> do_unsafe_branch_caching(Bin2); + _ -> Bin2 + end. + +%%-------------------------------------------------------------------- + +check(F, R) -> + R = F(). + +id(I) -> I. diff --git a/lib/hipe/test/bs_SUITE_data/bs_native_float.erl b/lib/hipe/test/bs_SUITE_data/bs_native_float.erl new file mode 100644 index 0000000000..15fe0bf0c6 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_native_float.erl @@ -0,0 +1,22 @@ +%% -*- erlang-indent-level: 2 -*- +%%------------------------------------------------------------------- +%% File : bs_native_float.erl +%% Author : Kostis Sagonas +%% Description : Test sent by Bjorn Gustavsson to report a bug in the +%% handling of the 'native' endian specifier. +%% Created : 28 Nov 2004 +%%------------------------------------------------------------------- +-module(bs_native_float). + +-export([test/0]). + +test() -> + BeamRes = mk_bin(1.0, 2.0, 3.0), + hipe:c(?MODULE), %% Original was: hipe:c({?MODULE,vs_to_bin,1}, [o2]), + HipeRes = mk_bin(1.0, 2.0, 3.0), + %% io:format("Beam result = ~w\nHiPE result = ~w\n", [BeamRes,HipeRes]), + BeamRes = HipeRes, + ok. + +mk_bin(X, Y, Z) -> + <<X:64/native-float, Y:64/native-float, Z:64/native-float>>. diff --git a/lib/hipe/test/bs_SUITE_data/bs_orber.erl b/lib/hipe/test/bs_SUITE_data/bs_orber.erl new file mode 100644 index 0000000000..c80ab8928d --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_orber.erl @@ -0,0 +1,26 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% Author : Per Gustafsson <[email protected]> +%%% Purpose : Checks that labels are handled properly from Core +%%% Created : 2 Nov 2004 +%%%------------------------------------------------------------------- +-module(bs_orber). + +-export([test/0]). + +test() -> + 1 = dec_giop_message_header(<<1,1:32/little-integer>>), + 1 = dec_giop_message_header(<<0,1:32/big-integer>>), + {2, 1} = dec_giop_message_header(<<2,1:32/little-integer>>), + {3, 1} = dec_giop_message_header(<<3,1:32/big-integer>>), + ok. + +dec_giop_message_header(<<1:8, MessSize:32/little-integer>>) -> + MessSize; +dec_giop_message_header(<<0:8, MessSize:32/big-integer>>) -> + MessSize; +dec_giop_message_header(<<Flags:8, MessSize:32/little-integer>>) when + ((Flags band 16#03) =:= 16#02) -> + {Flags, MessSize}; +dec_giop_message_header(<<Flags:8, MessSize:32/big-integer>>) -> + {Flags, MessSize}. diff --git a/lib/hipe/test/bs_SUITE_data/bs_pmatch.erl b/lib/hipe/test/bs_SUITE_data/bs_pmatch.erl new file mode 100644 index 0000000000..9474ffea4a --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_pmatch.erl @@ -0,0 +1,269 @@ +%% -*- erlang-indent-level: 2 -*- +%%-------------------------------------------------------------------- +%% Tests that basic cases of binary pattern matching work +%%-------------------------------------------------------------------- +-module(bs_pmatch). + +-export([test/0]). + +test() -> + %% construct some binaries + Bin42 = <<42>>, + Bin = <<12,17,42,0,0,0>>, + BinSS = <<0,1,0,0,0>>, + %% do some pattern matching + ok = pm_const(Bin42), + <<17,42,0,0,0>> = pm_tail(Bin), + 42 = pm_little(<<0:1,42:7>>), + 42 = pm_rec(Bin), + 30 = pm_rec_acc(<<1,2,3,4,5,6,7,8,9,10>>, 0), + 42 = pm_binary_tuple(Bin42), + -1 = pm_with_illegal_float(), + %% do some pattern matching with bound segments + ok = pm_bound_var(), + ok = pm_bound_tail(), + %% do some tests with floating point numbers + ok = pm_float(), + ok = pm_float_little(), + %% do some pattern matching with segments of unknown sizes + {<<17>>, <<42,0,0,0>>} = pm_body_s(Bin, 1), + {<<17>>, <<42,0,0,0>>} = pm_body_ss(Bin, 1, 4), + {<<45>>, <<>>} = pm_size_split(<<1:16,45>>), + {<<45>>, <<46,47>>} = pm_size_split(<<1:16,45,46,47>>), + {<<45,46>>, <<47>>} = pm_size_split(<<2:16,45,46,47>>), + {<<45,46>>, <<47>>} = pm_size_split_2(2, <<2:16,45,46,47>>), + {'EXIT',{function_clause,_}} = (catch pm_size_split_2(42, <<2:16,45,46,47>>)), + {<<45,46,47>>, <<48>>} = pm_sizes_split(<<16:8,3:16,45,46,47,48>>), + <<"cdef">> = pm_skip_segment(<<2:8, "abcdef">>), + -1 = pm_double_size_in_head(BinSS), + -1 = pm_double_size_in_body(BinSS), + %% and finally some cases which were problematic for various reasons + ok = pm_bigs(), + ok = pm_sean(), + ok = pm_bin8(<<1,2,3,4,5,6,7,8>>), + ok = pm_bs_match_string(), + ok = pm_till_gc(), + ok. + +%%-------------------- +%% Test cases below +%%-------------------- + +pm_const(<<42>>) -> + ok. + +pm_tail(<<12, Bin/binary>>) -> + Bin. + +pm_little(<<_:1, X:15/little>>) -> + {wrong, X}; +pm_little(<<_:1, X:7/little>>) -> + X. + +pm_rec(<<12, Bin/binary>>) -> + pm_rec(Bin); +pm_rec(<<17, Word:4/little-signed-integer-unit:8>>) -> + Word. + +pm_rec_acc(<<_:4, A:4, Rest/binary>>, Acc) -> + case Rest of + <<X, Y, 9, NewRest/binary>> -> + pm_rec_acc(NewRest, X+Y+Acc); + <<X, 5, NewRest/binary>> -> + pm_rec_acc(NewRest, X+Acc); + <<2, NewRest/binary>> -> + pm_rec_acc(NewRest, 1+Acc); + <<NewRest/binary>> -> + pm_rec_acc(NewRest, A+Acc) + end; +pm_rec_acc(<<>>, Acc) -> + Acc. + +pm_binary_tuple(<<X>>) -> + X; +pm_binary_tuple({Y, Z}) -> + Y + Z. + +pm_with_illegal_float() -> + Bin = <<-1:64>>, % create a binary which is illegal as float + pm_float_integer(Bin). % try to match it out as a float + +pm_float_integer(<<F:64/float>>) -> F; +pm_float_integer(<<I:64/integer-signed>>) -> I. + +%%-------------------------------------------------------------------- +%% Some tests with bound variables in segments + +pm_bound_var() -> + ok = pm_bound_var(42, 13, <<42,13>>), + no = pm_bound_var(42, 13, <<42,255>>), + no = pm_bound_var(42, 13, <<154,255>>), + ok. + +pm_bound_var(A, B, <<A:8, B:8>>) -> ok; +pm_bound_var(_, _, _) -> no. + +pm_bound_tail() -> + ok = pm_bound_tail(<<>>, <<13,14>>), + ok = pm_bound_tail(<<2,3>>, <<1,1,2,3>>), + no = pm_bound_tail(<<2,3>>, <<1,1,2,7>>), + no = pm_bound_tail(<<2,3>>, <<1,1,2,3,4>>), + no = pm_bound_tail(<<2,3>>, <<>>), + ok. + +pm_bound_tail(T, <<_:16, T/binary>>) -> ok; +pm_bound_tail(_, _) -> no. + +%%-------------------------------------------------------------------- +%% Floating point tests + +pm_float() -> + F = f1(), + G = f_one(), + G = match_float(<<63,128,0,0>>, 32, 0), + G = match_float(<<63,240,0,0,0,0,0,0>>, 64, 0), + fcmp(F, match_float(<<F:32/float>>, 32, 0)), + fcmp(F, match_float(<<F:64/float>>, 64, 0)), + fcmp(F, match_float(<<1:1,F:32/float,127:7>>, 32, 1)), + fcmp(F, match_float(<<1:1,F:64/float,127:7>>, 64, 1)), + fcmp(F, match_float(<<1:13,F:32/float,127:3>>, 32, 13)), + fcmp(F, match_float(<<1:13,F:64/float,127:3>>, 64, 13)), + ok. + +fcmp(F1, F2) when (F1 - F2) / F2 < 0.0000001 -> ok. + +match_float(Bin0, Fsz, I) -> + Bin = make_sub_bin(Bin0), + Bsz = bit_size(Bin), + Tsz = Bsz - Fsz - I, + <<_:I,F:Fsz/float,_:Tsz>> = Bin, + F. + +pm_float_little() -> + F = f2(), + G = f_one(), + G = match_float_little(<<0,0,0,0,0,0,240,63>>, 64, 0), + G = match_float_little(<<0,0,128,63>>, 32, 0), + fcmp(F, match_float_little(<<F:32/float-little>>, 32, 0)), + fcmp(F, match_float_little(<<F:64/float-little>>, 64, 0)), + fcmp(F, match_float_little(<<1:1,F:32/float-little,127:7>>, 32, 1)), + fcmp(F, match_float_little(<<1:1,F:64/float-little,127:7>>, 64, 1)), + fcmp(F, match_float_little(<<1:13,F:32/float-little,127:3>>, 32, 13)), + fcmp(F, match_float_little(<<1:13,F:64/float-little,127:3>>, 64, 13)), + ok. + +match_float_little(Bin0, Fsz, I) -> + Bin = make_sub_bin(Bin0), + Bsz = bit_size(Bin), + Tsz = Bsz - Fsz - I, + <<_:I, F:Fsz/float-little, _:Tsz>> = Bin, + F. + +make_sub_bin(Bin0) -> + Sz = byte_size(Bin0), + Bin1 = <<37,Bin0/binary,38,39>>, + <<_:8,Bin:Sz/binary,_:8,_:8>> = Bin1, + Bin. + +f1() -> 3.1415. + +f2() -> 2.7133. + +f_one() -> 1.0. + +%%-------------------------------------------------------------------- +%% Some tests using size fields specified within the binary +pm_body_s(Bin, S1) -> + <<12, B1:S1/binary, B2:4/binary>> = Bin, %% 4 is hard-coded + {B1, B2}. + +pm_body_ss(Bin, S1, S2) -> + <<12, B1:S1/binary, B2:S2/binary>> = Bin, + {B1, B2}. + +pm_size_split(<<N:16, B:N/binary, T/binary>>) -> + {B, T}. + +pm_size_split_2(N, <<N:16, B:N/binary, T/binary>>) -> + {B, T}. + +pm_sizes_split(<<N0:8, N:N0, B:N/binary, T/binary>>) -> + {B, T}. + +pm_skip_segment(<<N:8, _:N/binary, T/binary>>) -> T. + +%%-------------------------------------------------------------------- +%% Some tests using multiple occurrences of size fields +pm_double_size_in_head(<<S:16, _:S/binary, _:S/binary, _/binary>>) -> + -S. + +pm_double_size_in_body(Bin) -> + <<S:16, _:S/binary, _:S/binary, _/binary>> = Bin, + -S. + +%%-------------------------------------------------------------------- +%% matching with 64-bit integers which become big nums +-define(BIG, 16#7fffffff7fffffff). + +pm_bigs() -> + <<X:64/little>> = <<?BIG:64/little>>, + true = (X =:= big()), + <<Y:64>> = <<?BIG:64>>, + true = (Y =:= big()), + ok. + +big() -> ?BIG. + +%%-------------------------------------------------------------------- + +pm_sean() -> + small = sean1(<<>>), + small = sean1(<<1>>), + small = sean1(<<1,2>>), + small = sean1(<<1,2,3>>), + large = sean1(<<1,2,3,4>>), + small = sean1(<<4>>), + small = sean1(<<4,5>>), + small = sean1(<<4,5,6>>), + {'EXIT', {function_clause, _}} = (catch sean1(<<4,5,6,7>>)), + ok. + +sean1(<<B/binary>>) when byte_size(B) < 4 -> small; +sean1(<<1, _/binary>>) -> large. + +%%-------------------------------------------------------------------- +%% Crashed on SPARC due to a bug in linear scan register allocator +pm_bin8(<<A, B, C, D, E, F, G, H>>) -> + 10 = add4(A, B, C, D), + 26 = add4(E, F, G, H), + ok. + +add4(X, Y, Z, W) -> + X + Y + Z + W. + +%%-------------------------------------------------------------------- +%% Cases that exposed bugs in the handling of bs_match_string with an +%% empty destination list. Reported on 2013/2/12 and fixed 2013/3/10. + +pm_bs_match_string() -> + Bin = <<42,42>>, + Bin = pm_match_string_head(Bin), + ok = (pm_match_string_fun())(Bin). + +pm_match_string_head(<<42, _/bits>> = B) -> B. + +pm_match_string_fun() -> + fun (<<X, _/bits>>) when X =:= 42 -> ok end. + +%%-------------------------------------------------------------------- +%% Match a lot to force a garbage collection which exposed a bug + +pm_till_gc() -> + Bin = <<16#76543210:32>>, + 16#76543210 = pm_a_lot(Bin, 1000000), + ok. + +pm_a_lot(<<X:32>>, 0) -> + X; +pm_a_lot(<<X:32>>, N) -> + pm_a_lot(<<X:32>>, N-1). diff --git a/lib/hipe/test/bs_SUITE_data/bs_pmatch_bugs.erl b/lib/hipe/test/bs_SUITE_data/bs_pmatch_bugs.erl new file mode 100644 index 0000000000..b280705a47 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_pmatch_bugs.erl @@ -0,0 +1,67 @@ +%% -*- erlang-indent-level: 2 -*- +%%-------------------------------------------------------------------- +-module(bs_pmatch_bugs). + +-export([test/0]). + +test() -> + Bin = <<"123.123">>, + <<49,50,51>> = lex_digits1(Bin, 1, []), + <<49,50,51>> = lex_digits2(Bin, 1, []), + ok = var_bind_bug(<<1, 2, 3, 4, 5, 6, 7, 8>>), + ok. + +%%-------------------------------------------------------------------- +%% One of the lex_digits functions below gave incorrect results due to +%% incorrect pattern matching compilation of binaries by the byte code +%% compiler. Fixed by Bjorn Gustavsson on 5/3/2003. +%% -------------------------------------------------------------------- +lex_digits1(<<$., Rest/binary>>, _Val, _Acc) -> + Rest; +lex_digits1(<<N, Rest/binary>>, Val, Acc) when N >= $0, N =< $9 -> + lex_digits1(Rest, Val * 10 + dec(N), Acc); +lex_digits1(_Other, _Val, _Acc) -> + not_ok. + +lex_digits2(<<N, Rest/binary>>,Val, Acc) when N >= $0, N =< $9 -> + lex_digits2(Rest, Val * 10 + dec(N), Acc); +lex_digits2(<<$., Rest/binary>>, _Val, _Acc) -> + Rest; +lex_digits2(_Other, _Val, _Acc) -> + not_ok. + +dec(A) -> + A - $0. + +%%-------------------------------------------------------------------- +%% From: Bernard Duggan +%% Date: 11/3/2011 +%% +%% I've just run into an interesting little bit of behaviour that +%% doesn't seem quite right. erlc gives me the warning +%% +%% 43: Warning: this clause cannot match because a previous +%% clause at line 42 always matches +%% (line 42 is the "B -> wrong;" line). +%% +%% And sure enough, if you run test/0 you get 'wrong' back. +%% +%% That, in itself, is curious to me since by my understanding B should +%% be bound by the function header, and have no guarantee of being the +%% same as A. I can't see how it could be unbound. +%% +%% Doubly curious, is that if I stop using B as the size specifier of C, +%% like this: +%% +%% match(<<A:1/binary, B:8/integer, _C:1/binary, _Rest/binary>>) -> +%% +%% the warning goes away. And the result becomes 'ok' (in spite of +%% nothing in the body having changed, and the only thing changing in +%% the header being the size of an unused variable at the tail of the +%% binary). +%%-------------------------------------------------------------------- +var_bind_bug(<<A:1/binary, B:8/integer, _C:B/binary, _Rest/binary>>) -> + case A of + B -> wrong; + _ -> ok + end. diff --git a/lib/hipe/test/bs_SUITE_data/bs_pmatch_in_guards.erl b/lib/hipe/test/bs_SUITE_data/bs_pmatch_in_guards.erl new file mode 100644 index 0000000000..159227bb92 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_pmatch_in_guards.erl @@ -0,0 +1,23 @@ +%% -*- erlang-indent-level: 2 -*- +%%-------------------------------------------------------------------- +%% Tests that basic cases of binary pattern matching in guards work +%%-------------------------------------------------------------------- +-module(bs_pmatch_in_guards). + +-export([test/0]). + +test() -> + 1 = in_guard(<<16#74ad:16>>, 16#e95, 5), + 2 = in_guard(<<16#3A,16#F7,"hello">>, 16#3AF7, <<"hello">>), + 3 = in_guard(<<16#FBCD:14,3.1415/float,3:2>>, 16#FBCD, 3.1415), + nope = in_guard(<<1>>, 42, b), + nope = in_guard(<<1>>, a, b), + nope = in_guard(<<1,2>>, 1, 1), + nope = in_guard(<<4,5>>, 1, 2.71), + nope = in_guard(<<4,5>>, 1, <<12,13>>), + ok. + +in_guard(Bin, A, B) when <<A:13,B:3>> == Bin -> 1; +in_guard(Bin, A, B) when <<A:16,B/binary>> == Bin -> 2; +in_guard(Bin, A, B) when <<A:14,B/float,3:2>> == Bin -> 3; +in_guard(_, _, _) -> nope. diff --git a/lib/hipe/test/bs_SUITE_data/bs_potpurri.erl b/lib/hipe/test/bs_SUITE_data/bs_potpurri.erl new file mode 100644 index 0000000000..8bc4fe5c88 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_potpurri.erl @@ -0,0 +1,200 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +-module(bs_potpurri). + +-export([test/0]). + +test() -> + ok = integer(), + ok = signed_integer(), + ok = dynamic(), + ok = more_dynamic(), + ok = mml(), + ok. + +%% compile(Opts0) -> +%% case proplists:get_bool(core, Opts0) of +%% true -> +%% test:note(?MODULE, "disabling compilation from core - BUG"), +%% Opts = [{core,false}|Opts0]; +%% false -> +%% Opts = Opts0 +%% end, +%% hipe:c(?MODULE, Opts). + +integer() -> + 0 = get_int(mkbin([])), + 0 = get_int(mkbin([0])), + 42 = get_int(mkbin([42])), + 255 = get_int(mkbin([255])), + 256 = get_int(mkbin([1,0])), + 257 = get_int(mkbin([1,1])), + 258 = get_int(mkbin([1,2])), + 258 = get_int(mkbin([1,2])), + 65534 = get_int(mkbin([255,254])), + 16776455 = get_int(mkbin([255,253,7])), + 4245492555 = get_int(mkbin([253,13,19,75])), + L = [200,1,19,128,222,42,97,111,200,1,19,128,222,42,97,111], + ok = cmp128(mkbin(L), uint(L)), + ok = fun_clause(catch get_int(mkbin(lists:seq(1,5)))), + ok. + +get_int(<<I:0>>) -> I; +get_int(<<I:8>>) -> I; +get_int(<<I:16>>) -> I; +get_int(<<I:24>>) -> I; +get_int(<<I:32>>) -> I. + +cmp128(<<I:128>>, I) -> ok; +cmp128(_Bin, _I) -> not_ok. + +signed_integer() -> + {no_match,_} = sint(mkbin([])), + {no_match,_} = sint(mkbin([1,2,3])), + 127 = sint(mkbin([127])), + -1 = sint(mkbin([255])), + -128 = sint(mkbin([128])), + 42 = sint(mkbin([42,255])), + 127 = sint(mkbin([127,255])), + ok. + +sint(Bin) -> + case Bin of + <<I:8/signed>> -> I; + <<I:8/signed,_:3,_:5>> -> I; + Other -> {no_match,Other} + end. + +uint(L) -> uint(L, 0). + +uint([H|T], Acc) -> uint(T, Acc bsl 8 bor H); +uint([], Acc) -> Acc. + +dynamic() -> + ok = dynamic(mkbin([255]), 8), + ok = dynamic(mkbin([255,255]), 16), + ok = dynamic(mkbin([255,255,255]), 24), + ok = dynamic(mkbin([255,255,255,255]), 32), + ok. + +dynamic(Bin, S1) when S1 >= 0 -> + S2 = bit_size(Bin) - S1, + dynamic(Bin, S1, S2, (1 bsl S1) - 1, (1 bsl S2) - 1), + dynamic(Bin, S1-1); +dynamic(_Bin, _) -> ok. + +dynamic(Bin, S1, S2, A, B) -> + %% io:format("~p ~p ~p ~p\n", [S1,S2,A,B]), + case Bin of + <<A:S1,B:S2>> -> + %% io:format("~p ~p ~p ~p\n", [S1,S2,A,B]), + ok; + <<A1:S1,B2:S2>> -> erlang:error(badmatch, [Bin,S1,S2,A,B,A1,B2]) + end. + +more_dynamic() -> + %% Unsigned big-endian numbers. + Unsigned = fun(Bin, List, SkipBef, N) -> + SkipAft = bit_size(Bin) - N - SkipBef, + <<_I1:SkipBef,Int:N,_I2:SkipAft>> = Bin, + Int = make_int(List, N, 0) + end, + ok = more_dynamic1(Unsigned, funny_binary(42)), + + %% Signed big-endian numbers. + Signed = fun(Bin, List, SkipBef, N) -> + SkipAft = bit_size(Bin) - N - SkipBef, + <<_I1:SkipBef,Int:N/signed,_I2:SkipAft>> = Bin, + case make_signed_int(List, N) of + Int -> ok; + Other -> + io:format("Bin = ~p,", [Bin]), + io:format("SkipBef = ~p, N = ~p", [SkipBef,N]), + io:format("Expected ~p, got ~p", [Int,Other]), + exit(Other) + end + end, + ok = more_dynamic1(Signed, funny_binary(43)), + + %% Unsigned little-endian numbers. + UnsLittle = fun(Bin, List, SkipBef, N) -> + SkipAft = bit_size(Bin) - N - SkipBef, + <<_I1:SkipBef,Int:N/little,_I2:SkipAft>> = Bin, + Int = make_int(big_to_little(List, N), N, 0) + end, + more_dynamic1(UnsLittle, funny_binary(44)), + + %% Signed little-endian numbers. + SignLittle = fun(Bin, List, SkipBef, N) -> + SkipAft = bit_size(Bin) - N - SkipBef, + <<_I1:SkipBef,Int:N/signed-little,_I2:SkipAft>> = Bin, + Little = big_to_little(List, N), + Int = make_signed_int(Little, N) + end, + ok = more_dynamic1(SignLittle, funny_binary(45)), + + ok. + +funny_binary(N) -> + B0 = erlang:md5([N]), + {B1,_B2} = split_binary(B0, byte_size(B0) div 2), + B1. + +more_dynamic1(Action, Bin) -> + BitList = bits_to_list(binary_to_list(Bin), 16#80), + more_dynamic2(Action, Bin, BitList, 0). + +more_dynamic2(Action, Bin, [_|T]=List, Bef) -> + more_dynamic3(Action, Bin, List, Bef, bit_size(Bin)), + more_dynamic2(Action, Bin, T, Bef+1); +more_dynamic2(_Action, _Bin, [], _Bef) -> ok. + +more_dynamic3(Action, Bin, List, Bef, Aft) when Bef =< Aft -> + %% io:format("~p, ~p", [Bef,Aft-Bef]), + Action(Bin, List, Bef, Aft-Bef), + more_dynamic3(Action, Bin, List, Bef, Aft-1); +more_dynamic3(_, _, _, _, _) -> ok. + +big_to_little(List, N) -> big_to_little(List, N, []). + +big_to_little([B0,B1,B2,B3,B4,B5,B6,B7|T], N, Acc) when N >= 8 -> + big_to_little(T, N-8, [B0,B1,B2,B3,B4,B5,B6,B7|Acc]); +big_to_little(List, N, Acc) -> lists:sublist(List, 1, N) ++ Acc. + +make_signed_int(_List, 0) -> 0; +make_signed_int([0|_]=List, N) -> make_int(List, N, 0); +make_signed_int([1|_]=List0, N) -> + List1 = reversed_sublist(List0, N, []), + List2 = two_complement_and_reverse(List1, 1, []), + -make_int(List2, length(List2), 0). + +reversed_sublist(_List, 0, Acc) -> Acc; +reversed_sublist([H|T], N, Acc) -> reversed_sublist(T, N-1, [H|Acc]). + +two_complement_and_reverse([H|T], Carry, Acc) -> + Sum = 1 - H + Carry, + two_complement_and_reverse(T, Sum div 2, [Sum rem 2|Acc]); +two_complement_and_reverse([], Carry, Acc) -> [Carry|Acc]. + +make_int(_List, 0, Acc) -> Acc; +make_int([H|T], N, Acc) -> make_int(T, N-1, Acc bsl 1 bor H). + +bits_to_list([_|T], 0) -> bits_to_list(T, 16#80); +bits_to_list([H|_]=List, Mask) -> + [case H band Mask of + 0 -> 0; + _ -> 1 + end|bits_to_list(List, Mask bsr 1)]; +bits_to_list([], _) -> []. + +fun_clause({'EXIT',{function_clause,_}}) -> ok. + +mkbin(L) when is_list(L) -> list_to_binary(L). + +mml() -> + single_byte_binary = mml_choose(<<42>>), + multi_byte_binary = mml_choose(<<42,43>>), + ok. + +mml_choose(<<_:8>>) -> single_byte_binary; +mml_choose(<<_:8, _T/binary>>) -> multi_byte_binary. diff --git a/lib/hipe/test/bs_SUITE_data/bs_remove3.erl b/lib/hipe/test/bs_SUITE_data/bs_remove3.erl new file mode 100644 index 0000000000..a98b0b5b28 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_remove3.erl @@ -0,0 +1,104 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% File : bs_remove3.erl +%%% Author : Per Gustafsson <[email protected]> +%%% Purpose : +%%% +%%% Created : 13 Apr 2004 by Per Gustafsson +%%%------------------------------------------------------------------- +-module(bs_remove3). + +-export([test/0]). + +-define(A, <<56,0,120,0,0,31,255,255,102,42,12,0,3,3,16,5,24,3,240,0,0,32,0,196, + 2,128,4,0,255,255,254,33,68,96,0,8,8,213,40,192,31,196,0,4,0,0>>). +-define(B, <<28,32,0,96,0,8,0,7,255,255,212,33,98,12,0,0,1,0,48,72,66,3,0,7,240, + 64,0,0,8,0,0,224,0,10,128,0,64,0,63,255,254,133,10,80,96,0,0,8,1,6, + 18,4,24,0,63,128,0,0,4,64,0,0>>). + +test() -> + Bin1 = <<30,16,0,90,0,1,0,0,255,255,255,255,81,67,101,7,0, + 0,0,96,6,12,146,18,14,0,15,252,16,0,0,17,0,0>>, + Bin = <<Bin1/binary, Bin1/binary>>, + ?A = loop(Bin, 10, fun run_list/1), + ?A = loop(Bin, 10, fun run_bin/1), + ?B = loop(Bin, 10, fun r31/1), + ok. + +loop(Arg, 0, F) -> + F(Arg); +loop(Arg, N, F) -> + F(Arg), + loop(Arg, N-1, F). + +run_list(Bin) -> + List = run1(Bin), + list_to_binary(List). + +run1(<<A1:2,_:1,A2:2,_:1,A3:2,_:1,A4:2,_:1, + A5:2,_:1,A6:2,_:1,A7:2,_:1,A8:2,_:1,Rest/binary>>) -> + [<<A1:2,A2:2,A3:2,A4:2,A5:2,A6:2,A7:2,A8:2>>, run2(Rest)]; +run1(<<A1:2,_:1,A2:2,_:1,A3:2,_:1,A4:2,_:1,A5:2,_:1,A6:1>>) -> + [<<A1:2,A2:2,A3:2,A4:2,A5:2,A6:1,0:5>>]; +run1(<<A1:2,_:1,A2:2,_:1,A3:2>>) -> + [<<A1:2,A2:2,A3:2,0:2>>]; +run1(<<>>) -> + []. + +run_bin(Bin) -> + run2(Bin). + +run2(<<A1:2,_:1,A2:2,_:1,A3:2,_:1,A4:2,_:1, + A5:2,_:1,A6:2,_:1,A7:2,_:1,A8:2,_:1,Rest/binary>>) -> + Bin = run2(Rest), + <<A1:2,A2:2,A3:2,A4:2,A5:2,A6:2,A7:2,A8:2,Bin/binary>>; +run2(<<A1:2,_:1,A2:2,_:1,A3:2,_:1,A4:2,_:1,A5:2,_:1,A6:1>>) -> + <<A1:2,A2:2,A3:2,A4:2,A5:2,A6:1,0:5>>; +run2(<<A1:2,_:1,A2:2,_:1,A3:2>>) -> + <<A1:2,A2:2,A3:2,0:2>>; +run2(<<>>) -> + <<>>. + +r31(Bin) -> + List = remove3rd1(0, 0, Bin, [-1]), + build(List, Bin, 0, <<>>). + +build([N1, N2|Rest], Bin, N, Present) -> + X = N1+1, Y = N2-X, + S = rest(N2), + <<_:X,A:Y,_:S,_/binary>> = Bin, + S1 = rest(N+Y), + NewPresent = <<Present:N/binary-unit:1, A:Y, 0:S1>>, + build([N2|Rest], Bin, N+Y, NewPresent); + +build([_], _Bin, _N, Present) -> + Present. + +rest(X) -> + case 8 - (X rem 8) of + 8 -> 0; + H -> H + end. + +remove3rd1(N, 2, Bin, List) -> + S = rest(N+1), + case Bin of + <<_:N, 1:1, _:S,_/binary>> -> + remove3rd1(N+1, 0, Bin, [N|List]); + <<_:N, 0:1, _:S,_/binary>> -> + remove3rd1(N+1, 2, Bin, List); + _ -> + Size = byte_size(Bin) * 8, + lists:reverse([Size|List]) + end; +remove3rd1(N, I, Bin, List) -> + S = rest(N+1), + case Bin of + <<_:N, 1:1, _:S,_/binary>> -> + remove3rd1(N+1, I+1, Bin, List); + <<_:N, 0:1, _:S,_/binary>> -> + remove3rd1(N+1, I, Bin, List); + _ -> + Size = byte_size(Bin) * 8, + lists:reverse([Size|List]) + end. diff --git a/lib/hipe/test/bs_SUITE_data/bs_save.erl b/lib/hipe/test/bs_SUITE_data/bs_save.erl new file mode 100644 index 0000000000..fe2b1105f2 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_save.erl @@ -0,0 +1,21 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% File : bs_save.erl +%%% Author : Per Gustafsson +%%% Purpose : Tests that compilation works for bs_save +%%% Created : 1 Nov 2007 +%%%------------------------------------------------------------------- +-module(bs_save). + +-export([test/0]). + +test() -> + {[16257, 1], <<0>>} = inc_on_ones(<<255,1,128,1,128,0>>, 0, [], 5), + ok. + +inc_on_ones(Buffer, _Av, Al, 0) -> + {lists:reverse(Al), Buffer}; +inc_on_ones(<<1:1, H:7, T/binary>>, Av, Al, Len) -> + inc_on_ones(T, (Av bsl 7) bor H, Al, Len-1); +inc_on_ones(<<H, T/binary>>, Av, Al, Len) -> + inc_on_ones(T, 0, [((Av bsl 7) bor H)|Al], Len-1). diff --git a/lib/hipe/test/bs_SUITE_data/bs_shell_native.erl b/lib/hipe/test/bs_SUITE_data/bs_shell_native.erl new file mode 100644 index 0000000000..b438f8d9ef --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_shell_native.erl @@ -0,0 +1,275 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% File : bs_shell_native.erl +%%% Author : Per Gustafsson <[email protected]> +%%% Purpose : Tests that the Erlang shell works well when in native +%%% Created : 6 Sep 2006 +%%%------------------------------------------------------------------- +-module(bs_shell_native). + +-export([prepare_for_test/0, test/0]). +%% These need to be exported so that we emulate calling them from the shell +-export([parse_and_eval/1, receiver/1, receiver_alot/1, send_alot/3]). + +%% This makes sure the shell runs native code +prepare_for_test() -> + lists:foreach(fun (M) -> {ok, M} = hipe:c(M) end, [erl_bits, erl_eval]). + +test() -> + ok = eval_bits_in_shell(), + ok = eval_bin_comp_in_shell(), + ok. + +%%-------------------------------------------------------------------- +%% Tests for bit stream operations including matching, construction +%% and binary_to_list, list_to_binary in the shell +eval_bits_in_shell() -> + <<1:100>> = parse_and_eval("<<1:100>> = <<1:100>>."), + ok = match(7), + ok = match(9), + ok = match1(15), + ok = match1(31), + ok = horrid_match(), + ok = test_bitstr(), + ok = test_bitsize(), + ok = asymmetric_tests(), + ok = big_asymmetric_tests(), + ok = binary_to_and_from_list(), + ok = big_binary_to_and_from_list(), + ok = send_and_receive(), + ok = send_and_receive_alot(), + ok. + +parse_and_eval(String) -> + {ok, Toks, _} = erl_scan:string(String), + {ok, Exprs} = erl_parse:parse_exprs(Toks), + Bnds = erl_eval:new_bindings(), + case erl_eval:exprs(Exprs, Bnds) of + {value, V, _} -> + V; + V -> + V + end. + +match(N) -> + Str = "N =" ++ integer_to_list(N) ++ ", <<0:N>> = <<0:N>>.", + <<0:N>> = parse_and_eval(Str), + ok. + +match1(N) -> + Str = "N =" ++ integer_to_list(N) ++ ", <<42:N/little>> = <<42:N/little>>.", + <<42:N/little>> = parse_and_eval(Str), + ok. + +test_bitsize() -> + 101 = parse_and_eval("101 = erlang:bit_size(<<1:101>>)."), + 1001 = parse_and_eval("1001 = erlang:bit_size(<<1:1001>>)."), + 80 = parse_and_eval("80 = erlang:bit_size(<<1:80>>)."), + 800 = parse_and_eval("800 = erlang:bit_size(<<1:800>>)."), + S = + "Bin = <<0:16#1000000>>," + "BigBin = list_to_bitstring([Bin||_ <- lists:seq(1,16#10)] ++ [<<1:1>>])," + "16#10000001 = erlang:bit_size(BigBin).", + 16#10000001 = parse_and_eval(S), + %% Only run these on computers with lots of memory + %% HugeBin = list_to_bitstring([BigBin||_ <- lists:seq(1,16#10)]++[<<1:1>>]), + %% 16#100000011 = erlang:bit_size(HugeBin), + 0 = parse_and_eval("0 = erlang:bit_size(<<>>)."), + ok. + +horrid_match() -> + S = "<<1:4,B:24/bitstring>> = <<1:4,42:24/little>>, <<42:24/little>> = B.", + <<42:24/little>> = parse_and_eval(S), + ok. + +test_bitstr() -> + S = + "<<1:7,B/bitstring>> = <<1:7,<<1:1,6>>/bitstring>>," + "<<1:1,6>> = B," + "B = <<1:1,6>>.", + <<1:1,6>> = parse_and_eval(S), + ok. + +asymmetric_tests() -> + <<1:12>> = parse_and_eval("<<1:12>> = <<0,1:4>>."), + <<0,1:4>> = parse_and_eval("<<0,1:4>> = <<1:12>>."), + S1 = + "<<1:1,X/bitstring>> = <<128,255,0,0:2>>," + "<<1,254,0,0:1>> = X," + "X = <<1,254,0,0:1>>.", + <<1,254,0,0:1>> = parse_and_eval(S1), + S2 = + "<<1:1,X1:25/bitstring>> = <<128,255,0,0:2>>," + "<<1,254,0,0:1>> = X1," + "X1 = <<1,254,0,0:1>>.", + <<1,254,0,0:1>> = parse_and_eval(S2), + ok. + +big_asymmetric_tests() -> + <<1:875,1:12>> = parse_and_eval("<<1:875,1:12>> = <<1:875,0,1:4>>."), + <<1:875,0,1:4>> = parse_and_eval("<<1:875,0,1:4>> = <<1:875,1:12>>."), + S1 = + "<<1:1,X/bitstring>> = <<128,255,0,0:2,1:875>>," + "<<1,254,0,0:1,1:875>> = X," + "X = <<1,254,0,0:1,1:875>>.", + <<1,254,0,0:1,1:875>> = parse_and_eval(S1), + S2 = + "<<1:1,X1:900/bitstring>> = <<128,255,0,0:2,1:875>>," + "<<1,254,0,0:1,1:875>> = X1," + "X1 = <<1,254,0,0:1,1:875>>.", + parse_and_eval(S2), + ok. + +binary_to_and_from_list() -> + <<1:7>> = parse_and_eval("list_to_bitstring(bitstring_to_list(<<1:7>>))."), + <<1,2,3,4,1:1>> = parse_and_eval("list_to_bitstring(bitstring_to_list(<<1,2,3,4,1:1>>))."), + [1,2,3,4,<<1:1>>] = parse_and_eval("bitstring_to_list(<<1,2,3,4,1:1>>)."), + <<1:1,1,2,3,4>> = parse_and_eval("list_to_bitstring([<<1:1>>,1,2,3,4])."), + [128,129,1,130,<<0:1>>] = parse_and_eval("bitstring_to_list(<<1:1,1,2,3,4>>)."), + ok. + +big_binary_to_and_from_list() -> + S1 = "erlang:list_to_bitstring(bitstring_to_list(<<1:800,2,3,4,1:1>>)).", + <<1:800,2,3,4,1:1>> = parse_and_eval(S1), + S2 = "erlang:bitstring_to_list(<<1,2,3,4,1:800,1:1>>).", + [1,2,3,4|_Rest1] = parse_and_eval(S2), + S3 = "erlang:list_to_bitstring([<<1:801>>,1,2,3,4]).", + <<1:801,1,2,3,4>> = parse_and_eval(S3), + ok. + +send_and_receive() -> + S = + "Bin = <<1,2:7>>," + "Pid = spawn(fun() -> bs_shell_native:receiver(Bin) end)," + "Pid ! {self(),<<1:7,8:5,Bin/bitstring>>}," + "receive ok -> ok end.", + parse_and_eval(S). + +receiver(Bin) -> + receive + {Pid, <<1:7,8:5,Bin/bitstring>>} -> + Pid ! ok + end. + +send_and_receive_alot() -> + S = + "Bin = <<1:1000001>>," + "Pid = spawn(fun() -> bs_shell_native:receiver_alot(Bin) end)," + "bs_shell_native:send_alot(100,Bin,Pid).", + parse_and_eval(S). + +send_alot(N,Bin,Pid) when N > 0 -> + Pid ! {self(),<<1:7,8:5,Bin/bitstring>>}, + receive + ok -> + ok + end, + send_alot(N-1,Bin,Pid); +send_alot(0,_Bin,Pid) -> + Pid ! no_more, + ok. + +receiver_alot(Bin) -> + receive + {Pid, <<1:7,8:5,Bin/bitstring>>} -> + Pid ! ok; + no_more -> ok + end, + receiver_alot(Bin). + +%%-------------------------------------------------------------------- + +eval_bin_comp_in_shell() -> + ok = byte_aligned(), + ok = bit_aligned(), + ok = extended_byte_aligned(), + ok = extended_bit_aligned(), + ok = mixed(), + ok. + +byte_aligned() -> + <<"abcdefg">> = + parse_and_eval("<<\"abcdefg\">> = << <<(X+32)>> || <<X>> <= <<\"ABCDEFG\">> >>."), + <<1:32/little,2:32/little,3:32/little,4:32/little>> = + parse_and_eval("<<1:32/little,2:32/little,3:32/little,4:32/little>> = + << <<X:32/little>> || <<X:32>> <= <<1:32,2:32,3:32,4:32>> >>."), + <<1:32/little,2:32/little,3:32/little,4:32/little>> = + parse_and_eval("<<1:32/little,2:32/little,3:32/little,4:32/little>> = + << <<X:32/little>> || <<X:16>> <= <<1:16,2:16,3:16,4:16>> >>."), + ok. + +bit_aligned() -> + <<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>> = + parse_and_eval("<<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>> = + << <<(X+32):7>> || <<X>> <= <<\"ABCDEFG\">> >>."), + <<"ABCDEFG">> = + parse_and_eval("<<\"ABCDEFG\">> = + << <<(X-32)>> || <<X:7>> <= <<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>> >>."), + <<1:31/little,2:31/little,3:31/little,4:31/little>> = + parse_and_eval("<<1:31/little,2:31/little,3:31/little,4:31/little>> = + << <<X:31/little>> || <<X:31>> <= <<1:31,2:31,3:31,4:31>> >>."), + <<1:31/little,2:31/little,3:31/little,4:31/little>> = + parse_and_eval("<<1:31/little,2:31/little,3:31/little,4:31/little>> = + << <<X:31/little>> || <<X:15>> <= <<1:15,2:15,3:15,4:15>> >>."), + ok. + +extended_byte_aligned() -> + <<"abcdefg">> = + parse_and_eval("<<\"abcdefg\">> = << <<(X+32)>> || X <- \"ABCDEFG\" >>."), + "abcdefg" = + parse_and_eval("\"abcdefg\" = [(X+32) || <<X>> <= <<\"ABCDEFG\">>]."), + <<1:32/little,2:32/little,3:32/little,4:32/little>> = + parse_and_eval("<<1:32/little,2:32/little,3:32/little,4:32/little>> = + << <<X:32/little>> || X <- [1,2,3,4] >>."), + [256,512,768,1024] = + parse_and_eval("[256,512,768,1024] = + [X || <<X:16/little>> <= <<1:16,2:16,3:16,4:16>>]."), + ok. + +extended_bit_aligned() -> + <<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>> = + parse_and_eval("<<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>> = + << <<(X+32):7>> || X <- \"ABCDEFG\" >>."), + "ABCDEFG" = + parse_and_eval("\"ABCDEFG\" = [(X-32) || <<X:7>> <= +<<$a:7,$b:7,$c:7,$d:7,$e:7,$f:7,$g:7>>]."), + <<1:31/little,2:31/little,3:31/little,4:31/little>> = + parse_and_eval("<<1:31/little,2:31/little,3:31/little,4:31/little>> = + << <<X:31/little>> || X <- [1,2,3,4] >>."), + [256,512,768,1024] = + parse_and_eval("[256,512,768,1024] = + [X || <<X:15/little>> <= <<1:15,2:15,3:15,4:15>>]."), + ok. + +mixed() -> + <<2,3,3,4,4,5,5,6>> = + parse_and_eval("<<2,3,3,4,4,5,5,6>> = + << <<(X+Y)>> || <<X>> <= <<1,2,3,4>>, <<Y>> <= <<1,2>> >>."), + <<2,3,3,4,4,5,5,6>> = + parse_and_eval("<<2,3,3,4,4,5,5,6>> = + << <<(X+Y)>> || <<X>> <= <<1,2,3,4>>, Y <- [1,2] >>."), + <<2,3,3,4,4,5,5,6>> = + parse_and_eval("<<2,3,3,4,4,5,5,6>> = + << <<(X+Y)>> || X <- [1,2,3,4], Y <- [1,2] >>."), + [2,3,3,4,4,5,5,6] = + parse_and_eval("[2,3,3,4,4,5,5,6] = + [(X+Y) || <<X>> <= <<1,2,3,4>>, <<Y>> <= <<1,2>>]."), + [2,3,3,4,4,5,5,6] = + parse_and_eval("[2,3,3,4,4,5,5,6] = + [(X+Y) || <<X>> <= <<1,2,3,4>>, Y <- [1,2]]."), + <<2:3,3:3,3:3,4:3,4:3,5:3,5:3,6:3>> = + parse_and_eval("<<2:3,3:3,3:3,4:3,4:3,5:3,5:3,6:3>> = + << <<(X+Y):3>> || <<X:3>> <= <<1:3,2:3,3:3,4:3>>, <<Y:3>> <= <<1:3,2:3>> >>."), + <<2:3,3:3,3:3,4:3,4:3,5:3,5:3,6:3>> = + parse_and_eval("<<2:3,3:3,3:3,4:3,4:3,5:3,5:3,6:3>> = + << <<(X+Y):3>> || <<X:3>> <= <<1:3,2:3,3:3,4:3>>, Y <- [1,2] >>."), + <<2:3,3:3,3:3,4:3,4:3,5:3,5:3,6:3>> = + parse_and_eval("<<2:3,3:3,3:3,4:3,4:3,5:3,5:3,6:3>> = + << <<(X+Y):3>> || X <- [1,2,3,4], Y <- [1,2] >>."), + [2,3,3,4,4,5,5,6] = + parse_and_eval("[2,3,3,4,4,5,5,6] = + [(X+Y) || <<X:3>> <= <<1:3,2:3,3:3,4:3>>, <<Y:3>> <= <<1:3,2:3>>]."), + [2,3,3,4,4,5,5,6] = + parse_and_eval("[2,3,3,4,4,5,5,6] = + [(X+Y) || <<X:3>> <= <<1:3,2:3,3:3,4:3>>, Y <- [1,2]]."), + ok. diff --git a/lib/hipe/test/bs_SUITE_data/bs_split.erl b/lib/hipe/test/bs_SUITE_data/bs_split.erl new file mode 100644 index 0000000000..617543f789 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_split.erl @@ -0,0 +1,105 @@ +%% -*- erlang-indent-level: 2 -*- +%%-------------------------------------------------------------------- + +-module(bs_split). + +-export([test/0]). + +test() -> + Funs = [fun byte_split_binary/0, fun bit_split_binary/0, fun z_split/0], + lists:foreach(fun (F) -> ok = F() end, Funs). + +%%-------------------------------------------------------------------- + +byte_split_binary() -> + L = lists:seq(0, 57), + B = mkbin(L), + byte_split(L, B, byte_size(B)). + +byte_split(L, B, Pos) when Pos >= 0 -> + Sz1 = Pos, + Sz2 = byte_size(B) - Pos, + bs1(L, B, Pos, Sz1, Sz2); +byte_split(_, _, _) -> ok. + +bs1(L, B, Pos, Sz1, Sz2) -> + <<B1:Sz1/binary, B2:Sz2/binary>> = B, + bs2(L, B, Pos, B1, B2). + +bs2(L, B, Pos, B1, B2) -> + B1 = list_to_binary(lists:sublist(L, 1, Pos)), + bs3(L, B, Pos, B2). + +bs3(L, B, Pos, B2) -> + B2 = list_to_binary(lists:nthtail(Pos, L)), + byte_split(L, B, Pos - 1). + +%%-------------------------------------------------------------------- + +bit_split_binary() -> + Fun = fun(Bin, List, SkipBef, N) -> + SkipAft = bit_size(Bin) - N - SkipBef, + %% io:format("~p, ~p, ~p", [SkipBef,N,SkipAft]), + <<_I1:SkipBef,OutBin:N/binary-unit:1,_I2:SkipAft>> = Bin, + OutBin = make_bin_from_list(List, N) + end, + bit_split_binary1(Fun, erlang:md5(<<1,2,3>>)). + +bit_split_binary1(Action, Bin) -> + BitList = bits_to_list(binary_to_list(Bin), 16#80), + bit_split_binary2(Action, Bin, BitList, 0). + +bit_split_binary2(Action, Bin, [_|T]=List, Bef) -> + bit_split_binary3(Action, Bin, List, Bef, bit_size(Bin)), + bit_split_binary2(Action, Bin, T, Bef+1); +bit_split_binary2(_Action, _Bin, [], _Bef) -> ok. + +bit_split_binary3(Action, Bin, List, Bef, Aft) when Bef =< Aft -> + Action(Bin, List, Bef, (Aft-Bef) div 8 * 8), + bit_split_binary3(Action, Bin, List, Bef, Aft - 8); +bit_split_binary3(_, _, _, _, _) -> ok. + +make_bin_from_list(_List, 0) -> + mkbin([]); +make_bin_from_list(List, N) -> + list_to_binary([make_int(List, 8, 0), + make_bin_from_list(lists:nthtail(8, List), N - 8)]). + +make_int(_List, 0, Acc) -> Acc; +make_int([H|T], N, Acc) -> make_int(T, N-1, Acc bsl 1 bor H). + +bits_to_list([_|T], 0) -> bits_to_list(T, 16#80); +bits_to_list([H|_]=List, Mask) -> + [case H band Mask of + 0 -> 0; + _ -> 1 + end|bits_to_list(List, Mask bsr 1)]; +bits_to_list([], _) -> []. + +mkbin(L) when is_list(L) -> list_to_binary(L). + +%%-------------------------------------------------------------------- +%% Splits a series of null terminated segments of a binary without +%% creating any new sub-binaries until the zero is found. + +z_split() -> + [<<61,62,63>>] = z_split(<<61,62,63>>), + [<<61,62,63>>, <<>>] = z_split(<<61,62,63,0>>), + [<<61,62,63>>, <<64>>] = z_split(<<61,62,63,0,64>>), + [<<61,62,63>>, <<64,65,66>>] = z_split(<<61,62,63,0,64,65,66>>), + [<<61,62>>, <<64>>, <<>>, <<65,66>>] = z_split(<<61,62,0,64,0,0,65,66>>), + ok. + +z_split(B) when is_binary(B) -> + z_split(B, 0). + +z_split(B, N) -> + case B of + <<_B1:N/binary,0,_B2/binary>> -> % use skip_bits for B1, B2 + <<B1:N/binary,_,B2/binary>> = B, % and postpone the matching + [B1 | z_split(B2)]; + <<_:N/binary>> -> + [B]; + _ -> + z_split(B, N + 1) + end. diff --git a/lib/hipe/test/bs_SUITE_data/bs_system_limit_32.erl b/lib/hipe/test/bs_SUITE_data/bs_system_limit_32.erl new file mode 100644 index 0000000000..eccb0083bd --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_system_limit_32.erl @@ -0,0 +1,26 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%------------------------------------------------------------------- +%%% File : bs_system_limit_32.erl +%%% Author : Per Gustafsson <[email protected]> +%%% Purpose : Checks binary system limits on 32-bit machines +%%% Created : 14 May 2008 +%%%------------------------------------------------------------------- +-module(bs_system_limit_32). + +-export([test/0]). + +test() -> + case erlang:system_info(wordsize) of + 4 -> system_limit_32(); + 8 -> ok + end. + +system_limit_32() -> + {'EXIT', {badarg, _}} = (catch <<42:(id(-1))>>), + {'EXIT', {badarg, _}} = (catch <<42:(id(-389739873536870912))/unit:8>>), + {'EXIT', {system_limit, _}} = (catch <<32:536870912/unit:8>>), + {'EXIT', {system_limit, _}} = (catch <<42:(id(536870912))/unit:8>>), + {'EXIT', {system_limit, _}} = (catch <<42:(id(536870912))/unit:8,1:1>>), + ok. + +id(X) -> X. diff --git a/lib/hipe/test/bs_SUITE_data/bs_utf.erl b/lib/hipe/test/bs_SUITE_data/bs_utf.erl new file mode 100644 index 0000000000..368ad0cd20 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_utf.erl @@ -0,0 +1,356 @@ +%% -*- erlang-indent-level: 2 -*- +%%------------------------------------------------------------------- +%% Purpose: test support for UTF datatypes in binaries +%% +%% Most of it taken from emulator/test/bs_utf_SUITE.erl +%%------------------------------------------------------------------- + +-module(bs_utf). + +-export([test/0]). + +-include_lib("common_test/include/ct.hrl"). + +test() -> + ok = utf8_cm65(), + ok = utf8_roundtrip(), + ok = utf16_roundtrip(), + ok = utf32_roundtrip(), + %% The following were problematic for the LLVM backend + ok = utf8_illegal_sequences(), + ok = utf16_illegal_sequences(), + ok = utf32_illegal_sequences(), + ok. + +%%------------------------------------------------------------------- +%% A test with construction and matching + +utf8_cm65() -> + <<65>> = b65utf8(), + ok = m(<<65>>). + +b65utf8() -> + <<65/utf8>>. + +m(<<65/utf8>>) -> + ok. + +%%------------------------------------------------------------------- + +utf8_roundtrip() -> + ok = utf8_roundtrip(0, 16#D7FF), + ok = utf8_roundtrip(16#E000, 16#10FFFF), + ok. + +utf8_roundtrip(First, Last) when First =< Last -> + Bin = int_to_utf8(First), + Bin = id(<<First/utf8>>), + Bin = id(<<(id(<<>>))/binary,First/utf8>>), + Unaligned = id(<<3:2,First/utf8>>), + <<_:2,Bin/binary>> = Unaligned, + <<First/utf8>> = Bin, + <<First/utf8>> = make_unaligned(Bin), + utf8_roundtrip(First+1, Last); +utf8_roundtrip(_, _) -> + ok. + +%%------------------------------------------------------------------- + +utf16_roundtrip() -> + Big = fun utf16_big_roundtrip/1, + Little = fun utf16_little_roundtrip/1, + PidRefs = [spawn_monitor(fun() -> do_utf16_roundtrip(Fun) end) || + Fun <- [Big,Little]], + [receive {'DOWN', Ref, process, Pid, Reason} -> normal=Reason end || + {Pid, Ref} <- PidRefs], + ok. + +do_utf16_roundtrip(Fun) -> + do_utf16_roundtrip(0, 16#D7FF, Fun), + do_utf16_roundtrip(16#E000, 16#10FFFF, Fun). + +do_utf16_roundtrip(First, Last, Fun) when First =< Last -> + Fun(First), + do_utf16_roundtrip(First+1, Last, Fun); +do_utf16_roundtrip(_, _, _) -> ok. + +utf16_big_roundtrip(Char) -> + Bin = id(<<Char/utf16>>), + Bin = id(<<(id(<<>>))/binary,Char/utf16>>), + Unaligned = id(<<3:2,Char/utf16>>), + <<_:2,Bin/binary>> = Unaligned, + <<Char/utf16>> = Bin, + <<Char/utf16>> = make_unaligned(Bin), + ok. + +utf16_little_roundtrip(Char) -> + Bin = id(<<Char/little-utf16>>), + Bin = id(<<(id(<<>>))/binary,Char/little-utf16>>), + Unaligned = id(<<3:2,Char/little-utf16>>), + <<_:2,Bin/binary>> = Unaligned, + <<Char/little-utf16>> = Bin, + <<Char/little-utf16>> = make_unaligned(Bin), + ok. + +%%------------------------------------------------------------------- + +utf32_roundtrip() -> + Big = fun utf32_big_roundtrip/1, + Little = fun utf32_little_roundtrip/1, + PidRefs = [spawn_monitor(fun() -> do_utf32_roundtrip(Fun) end) || + Fun <- [Big,Little]], + [receive {'DOWN', Ref, process, Pid, Reason} -> normal=Reason end || + {Pid, Ref} <- PidRefs], + ok. + +do_utf32_roundtrip(Fun) -> + do_utf32_roundtrip(0, 16#D7FF, Fun), + do_utf32_roundtrip(16#E000, 16#10FFFF, Fun). + +do_utf32_roundtrip(First, Last, Fun) when First =< Last -> + Fun(First), + do_utf32_roundtrip(First+1, Last, Fun); +do_utf32_roundtrip(_, _, _) -> ok. + +utf32_big_roundtrip(Char) -> + Bin = id(<<Char/utf32>>), + Bin = id(<<(id(<<>>))/binary,Char/utf32>>), + Unaligned = id(<<3:2,Char/utf32>>), + <<_:2,Bin/binary>> = Unaligned, + <<Char/utf32>> = Bin, + <<Char/utf32>> = make_unaligned(Bin), + ok. + +utf32_little_roundtrip(Char) -> + Bin = id(<<Char/little-utf32>>), + Bin = id(<<(id(<<>>))/binary,Char/little-utf32>>), + Unaligned = id(<<3:2,Char/little-utf32>>), + <<_:2,Bin/binary>> = Unaligned, + <<Char/little-utf32>> = Bin, + <<Char/little-utf32>> = make_unaligned(Bin), + ok. + +%%------------------------------------------------------------------- + +utf8_illegal_sequences() -> + fail_range(16#10FFFF+1, 16#10FFFF+512), % Too large. + fail_range(16#D800, 16#DFFF), % Reserved for UTF-16. + + %% Illegal first character. + [fail(<<I,16#8F,16#8F,16#8F>>) || I <- lists:seq(16#80, 16#BF)], + + %% Short sequences. + short_sequences(16#80, 16#10FFFF), + + %% Overlong sequences. (Using more bytes than necessary + %% is not allowed.) + overlong(0, 127, 2), + overlong(128, 16#7FF, 3), + overlong(16#800, 16#FFFF, 4), + ok. + +fail_range(Char, End) when Char =< End -> + {'EXIT', _} = (catch <<Char/utf8>>), + Bin = int_to_utf8(Char), + fail(Bin), + fail_range(Char+1, End); +fail_range(_, _) -> ok. + +short_sequences(Char, End) -> + Step = (End - Char) div erlang:system_info(schedulers) + 1, + PidRefs = short_sequences_1(Char, Step, End), + [receive {'DOWN', Ref, process, Pid, Reason} -> normal=Reason end || + {Pid, Ref} <- PidRefs], + ok. + +short_sequences_1(Char, Step, End) when Char =< End -> + CharEnd = lists:min([Char+Step-1,End]), + [spawn_monitor(fun() -> + %% io:format("~p - ~p\n", [Char, CharEnd]), + do_short_sequences(Char, CharEnd) + end)|short_sequences_1(Char+Step, Step, End)]; +short_sequences_1(_, _, _) -> []. + +do_short_sequences(Char, End) when Char =< End -> + short_sequence(Char), + do_short_sequences(Char+1, End); +do_short_sequences(_, _) -> ok. + +short_sequence(I) -> + case int_to_utf8(I) of + <<S0:3/binary,_:8>> -> + <<S1:2/binary,R1:8>> = S0, + <<S2:1/binary,_:8>> = S1, + fail(S0), + fail(S1), + fail(S2), + fail(<<S2/binary,16#7F,R1,R1>>), + fail(<<S1/binary,16#7F,R1>>), + fail(<<S0/binary,16#7F>>); + <<S0:2/binary,_:8>> -> + <<S1:1/binary,R1:8>> = S0, + fail(S0), + fail(S1), + fail(<<S0/binary,16#7F>>), + fail(<<S1/binary,16#7F>>), + fail(<<S1/binary,16#7F,R1>>); + <<S:1/binary,_:8>> -> + fail(S), + fail(<<S/binary,16#7F>>) + end. + +overlong(Char, Last, NumBytes) when Char =< Last -> + overlong(Char, NumBytes), + overlong(Char+1, Last, NumBytes); +overlong(_, _, _) -> ok. + +overlong(Char, NumBytes) when NumBytes < 5 -> + case int_to_utf8(Char, NumBytes) of + <<Char/utf8>>=Bin -> + ?t:fail({illegal_encoding_accepted,Bin,Char}); + <<OtherChar/utf8>>=Bin -> + ?t:fail({illegal_encoding_accepted,Bin,Char,OtherChar}); + _ -> ok + end, + overlong(Char, NumBytes+1); +overlong(_, _) -> ok. + +fail(Bin) -> + fail_1(Bin), + fail_1(make_unaligned(Bin)). + +fail_1(<<Char/utf8>> = Bin) -> + ?t:fail({illegal_encoding_accepted, Bin, Char}); +fail_1(_) -> ok. + +%%------------------------------------------------------------------- + +utf16_illegal_sequences() -> + utf16_fail_range(16#10FFFF+1, 16#10FFFF+512), % Too large. + utf16_fail_range(16#D800, 16#DFFF), % Reserved for UTF-16. + lonely_hi_surrogate(16#D800, 16#DFFF), + leading_lo_surrogate(16#DC00, 16#DFFF), + ok. + +utf16_fail_range(Char, End) when Char =< End -> + {'EXIT', _} = (catch <<Char/big-utf16>>), + {'EXIT', _} = (catch <<Char/little-utf16>>), + utf16_fail_range(Char+1, End); +utf16_fail_range(_, _) -> ok. + +lonely_hi_surrogate(Char, End) when Char =< End -> + BinBig = <<Char:16/big>>, + BinLittle = <<Char:16/little>>, + case {BinBig,BinLittle} of + {<<Bad/big-utf16>>,_} -> + ?t:fail({lonely_hi_surrogate_accepted,Bad}); + {_,<<Bad/little-utf16>>} -> + ?t:fail({lonely_hi_surrogate_accepted,Bad}); + {_,_} -> + ok + end, + lonely_hi_surrogate(Char+1, End); +lonely_hi_surrogate(_, _) -> ok. + +leading_lo_surrogate(Char, End) when Char =< End -> + leading_lo_surrogate(Char, 16#D800, 16#DFFF), + leading_lo_surrogate(Char+1, End); +leading_lo_surrogate(_, _) -> ok. + +leading_lo_surrogate(HiSurr, LoSurr, End) when LoSurr =< End -> + BinBig = <<HiSurr:16/big,LoSurr:16/big>>, + BinLittle = <<HiSurr:16/little,LoSurr:16/little>>, + case {BinBig,BinLittle} of + {<<Bad/big-utf16,_/bits>>,_} -> + ?t:fail({leading_lo_surrogate_accepted,Bad}); + {_,<<Bad/little-utf16,_/bits>>} -> + ?t:fail({leading_lo_surrogate_accepted,Bad}); + {_,_} -> + ok + end, + leading_lo_surrogate(HiSurr, LoSurr+1, End); +leading_lo_surrogate(_, _, _) -> ok. + +%%------------------------------------------------------------------- + +utf32_illegal_sequences() -> + utf32_fail_range(16#10FFFF+1, 16#10FFFF+512), % Too large. + utf32_fail_range(16#D800, 16#DFFF), % Reserved for UTF-16. + utf32_fail_range(-100, -1), + ok. + +utf32_fail_range(Char, End) when Char =< End -> + {'EXIT', _} = (catch <<Char/big-utf32>>), + {'EXIT', _} = (catch <<Char/little-utf32>>), + case {<<Char:32>>,<<Char:32/little>>} of + {<<Unexpected/utf32>>,_} -> + ?t:fail(Unexpected); + {_,<<Unexpected/little-utf32>>} -> + ?t:fail(Unexpected); + {_,_} -> ok + end, + utf32_fail_range(Char+1, End); +utf32_fail_range(_, _) -> ok. + +%%------------------------------------------------------------------- +%% This function intentionally allows construction of UTF-8 sequence +%% in illegal ranges. + +int_to_utf8(I) when I =< 16#7F -> + <<I>>; +int_to_utf8(I) when I =< 16#7FF -> + B2 = I, + B1 = (I bsr 6), + <<1:1,1:1,0:1,B1:5,1:1,0:1,B2:6>>; +int_to_utf8(I) when I =< 16#FFFF -> + B3 = I, + B2 = (I bsr 6), + B1 = (I bsr 12), + <<1:1,1:1,1:1,0:1,B1:4,1:1,0:1,B2:6,1:1,0:1,B3:6>>; +int_to_utf8(I) when I =< 16#3FFFFF -> + B4 = I, + B3 = (I bsr 6), + B2 = (I bsr 12), + B1 = (I bsr 18), + <<1:1,1:1,1:1,1:1,0:1,B1:3,1:1,0:1,B2:6,1:1,0:1,B3:6,1:1,0:1,B4:6>>; +int_to_utf8(I) when I =< 16#3FFFFFF -> + B5 = I, + B4 = (I bsr 6), + B3 = (I bsr 12), + B2 = (I bsr 18), + B1 = (I bsr 24), + <<1:1,1:1,1:1,1:1,1:1,0:1,B1:2,1:1,0:1,B2:6,1:1,0:1,B3:6,1:1,0:1,B4:6, + 1:1,0:1,B5:6>>. + +%% int_to_utf8(I, NumberOfBytes) -> Binary. +%% This function can be used to construct overlong sequences. +int_to_utf8(I, 1) -> + <<I>>; +int_to_utf8(I, 2) -> + B2 = I, + B1 = (I bsr 6), + <<1:1,1:1,0:1,B1:5,1:1,0:1,B2:6>>; +int_to_utf8(I, 3) -> + B3 = I, + B2 = (I bsr 6), + B1 = (I bsr 12), + <<1:1,1:1,1:1,0:1,B1:4,1:1,0:1,B2:6,1:1,0:1,B3:6>>; +int_to_utf8(I, 4) -> + B4 = I, + B3 = (I bsr 6), + B2 = (I bsr 12), + B1 = (I bsr 18), + <<1:1,1:1,1:1,1:1,0:1,B1:3,1:1,0:1,B2:6,1:1,0:1,B3:6,1:1,0:1,B4:6>>. + +%%------------------------------------------------------------------- + +make_unaligned(Bin0) when is_binary(Bin0) -> + Bin1 = <<0:3,Bin0/binary,31:5>>, + Sz = byte_size(Bin0), + <<0:3,Bin:Sz/binary,31:5>> = id(Bin1), + Bin. + +%%------------------------------------------------------------------- +%% Just to prevent compiler optimizations + +id(X) -> X. diff --git a/lib/hipe/test/bs_SUITE_data/bs_var_segs.erl b/lib/hipe/test/bs_SUITE_data/bs_var_segs.erl new file mode 100644 index 0000000000..a20df04b53 --- /dev/null +++ b/lib/hipe/test/bs_SUITE_data/bs_var_segs.erl @@ -0,0 +1,76 @@ +%% -*- erlang-indent-level: 2 -*- +%%-------------------------------------------------------------------- +%% Author : Kostis Sagonas +%% Purpose : These tests are intended to test the construction and +%% matching of binaries using variable sizes +%% Notes : +%% - Added test that crashed BEAM compiler +%% - Added test that crashed when segments of size zero were used +%% and one that did not convert integers to floats when constructing +%% binaries. +%% - Added a construction test which crashed from core because of +%% problems with the effect flag (2004/11/15) +%%-------------------------------------------------------------------- +-module(bs_var_segs). + +-export([test/0]). + +test() -> + N1 = 18, + A1 = 2, + A1 = match1(N1, <<1:12, 2:N1, A1:2>>), + A1 = match2(N1, <<1:12, 2:N1/integer-little, A1:2>>), + N3 = 3, + A3 = <<1,2,3>>, + B3 = 2, + {A3, B3} = match3(N3, <<1:12, A3:N3/binary, B3:4>>), + N4 = 12, + B4 = <<1,2,3>>, + A4 = 2, + {A4, B4} = match4(N4, <<1:N4, A4:4, B4/binary>>), + Y = <<5>>, + Y = match5(a, Y), + <<73>> = gen1(8, 0, <<73>>), + <<171>> = gen2(8, 7, 2#10101010101010101), + <<0:64>> = construct(), + <<0:32>> = construct2(0), + ok = in_guard(<<16#BCD:14,3:2>>, 16#BCD), + ok. + +construct() -> + <<0:64/float>>. + +construct2(X) -> + <<X:32/little>>. + +match1(N, Bin) -> + <<1:12, 2:N, A:2>>=Bin, + A. + +match2(N, Bin) -> + <<1:12, 2:N/integer-little, A:2>>=Bin, + A. + +match3(N, Bin) -> + <<1:12, A:N/binary, B:4>>=Bin, + {A,B}. + +match4(N, Bin) -> + <<1:N, A:4, B/binary>>=Bin, + {A,B}. + +match5(X, Y) -> + case X of + a -> + Y2 = 8 + end, + <<5:Y2>> = Y. + +gen1(N, S, A) -> + <<A:S/binary-unit:1, A:(N-S)/binary-unit:1>>. + +gen2(N, S, A) -> + <<A:S/little, A:(N-S)/little>>. + +in_guard(Bin, A) when <<A:14,3:2>> == Bin -> ok; +in_guard(_, _) -> no. diff --git a/lib/hipe/test/hipe.spec b/lib/hipe/test/hipe.spec new file mode 100644 index 0000000000..2894f40354 --- /dev/null +++ b/lib/hipe/test/hipe.spec @@ -0,0 +1,6 @@ +%% -*- erlang -*- + +{alias, tests, "../hipe_test"}. + +{suites, tests, all}. + diff --git a/lib/hipe/test/hipe_SUITE.erl b/lib/hipe/test/hipe_SUITE.erl new file mode 100644 index 0000000000..a5b3924aa8 --- /dev/null +++ b/lib/hipe/test/hipe_SUITE.erl @@ -0,0 +1,53 @@ +%% ``Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. +%% +%% The Initial Developer of the Original Code is Ericsson Utvecklings AB. +%% Portions created by Ericsson are Copyright 1999, Ericsson Utvecklings +%% AB. All Rights Reserved.'' +%% +-module(hipe_SUITE). + +-compile([export_all]). +-include_lib("common_test/include/ct.hrl"). + +all() -> + [app, appup]. + +groups() -> + []. + +init_per_suite(Config) -> + case erlang:system_info(hipe_architecture) of + undefined -> {skip, "HiPE not available or enabled"}; + _ -> Config + end. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +app() -> + [{doc, "Test that the hipe app file is ok"}]. +app(Config) when is_list(Config) -> + ok = ?t:app_test(hipe, tolerant). + +appup() -> + [{doc, "Test that the hipe appup file is ok"}]. +appup(Config) when is_list(Config) -> + AppupFile = "hipe.appup", + AppupPath = filename:join([code:lib_dir(hipe), "ebin", AppupFile]), + {ok, [{_Vsn, [], []}]} = file:consult(AppupPath). diff --git a/lib/hipe/test/hipe_testsuite_driver.erl b/lib/hipe/test/hipe_testsuite_driver.erl new file mode 100644 index 0000000000..03ec7adfd0 --- /dev/null +++ b/lib/hipe/test/hipe_testsuite_driver.erl @@ -0,0 +1,181 @@ +-module(hipe_testsuite_driver). + +-export([create_all_suites/1, run/3]). + +-include_lib("kernel/include/file.hrl"). + +-type testcase() :: atom(). +-type file_type() :: 'device' | 'directory' | 'regular' | 'other'. +-type ext_posix() :: file:posix() | 'badarg'. + +-define(suite_suffix, "_SUITE"). +-define(data_folder, "_data"). +-define(suite_data, ?suite_suffix ++ ?data_folder). + +-record(suite, {suitename :: string(), + outputfile :: file:io_device(), + testcases :: [testcase()]}). + +-spec create_all_suites([string()]) -> 'ok'. + +create_all_suites(SuitesWithSuiteSuffix) -> + Suites = get_suites(SuitesWithSuiteSuffix), + lists:foreach(fun create_suite/1, Suites). + +-spec get_suites([string()]) -> [string()]. + +get_suites(SuitesWithSuiteSuffix) -> + Prefixes = [suffix(F, ?suite_suffix) || F <- SuitesWithSuiteSuffix], + [S || {yes, S} <- Prefixes]. + +suffix(String, Suffix) -> + case string:rstr(String, Suffix) of + 0 -> no; + Index -> + case string:substr(String, Index) =:= Suffix of + true -> {yes, string:sub_string(String, 1, Index-1)}; + false -> no + end + end. + +-spec file_type(file:filename()) -> {ok, file_type()} | {error, ext_posix()}. + +file_type(Filename) -> + case file:read_file_info(Filename) of + {ok, FI} -> {ok, FI#file_info.type}; + Error -> Error + end. + +-spec create_suite(string()) -> 'ok'. + +create_suite(SuiteName) -> + {ok, Cwd} = file:get_cwd(), + SuiteDirN = filename:join(Cwd, SuiteName ++ ?suite_data), + OutputFile = generate_suite_file(Cwd, SuiteName), + generate_suite(SuiteName, OutputFile, SuiteDirN). + +generate_suite_file(Cwd, SuiteName) -> + F = filename:join(Cwd, SuiteName ++ ?suite_suffix ++ ".erl"), + case file:open(F, [write]) of + {ok, IoDevice} -> IoDevice; + {error, _} = E -> exit({E, F}) + end. + +generate_suite(SuiteName, OutputFile, SuiteDirN) -> + TestCases = list_testcases(SuiteDirN), + Suite = #suite{suitename = SuiteName, outputfile = OutputFile, + testcases = TestCases}, + write_suite(Suite), + file:close(OutputFile). + +list_testcases(Dirname) -> + {ok, Files} = list_dir(Dirname, ".erl", true), + [list_to_atom(filename:basename(F, ".erl")) || F <- Files]. + +-spec list_dir(file:filename(), string(), boolean()) -> + {error, ext_posix()} | {ok, [file:filename()]}. + +list_dir(Dir, Extension, Dirs) -> + case file:list_dir(Dir) of + {error, _} = Error -> Error; + {ok, Filenames} -> + FullFilenames = [filename:join(Dir, F) || F <- Filenames], + Matches1 = case Dirs of + true -> + [F || F <- FullFilenames, + file_type(F) =:= {ok, 'directory'}]; + false -> [] + end, + Matches2 = [F || F <- FullFilenames, + file_type(F) =:= {ok, 'regular'}, + filename:extension(F) =:= Extension], + {ok, lists:sort(Matches1 ++ Matches2)} + end. + +write_suite(Suite) -> + write_header(Suite), + write_testcases(Suite). + +write_header(#suite{suitename = SuiteName, outputfile = OutputFile, + testcases = TestCases}) -> + Exports = format_export(TestCases), + TimeLimit = 3, %% with 1 or 2 it fails on some slow machines... + io:format(OutputFile, + "%% ATTENTION!\n" + "%% This is an automatically generated file. Do not edit.\n\n" + "-module(~s).\n\n" + "-export([suite/0, init_per_suite/0, init_per_suite/1,\n" + " end_per_suite/1, all/0]).\n" + "~s\n\n" + "-include_lib(\"common_test/include/ct.hrl\").\n\n" + "suite() ->\n" + " [{timetrap, {minutes, ~w}}].\n\n" + "init_per_suite() ->\n" + " [].\n\n" + "init_per_suite(Config) ->\n" + " case erlang:system_info(hipe_architecture) of\n" + " undefined -> {skip, \"HiPE not available or enabled\"};\n" + " _ -> Config\n" + " end.\n\n" + "end_per_suite(_Config) ->\n" + " ok.\n\n" + "all() ->\n" + " ~p.\n\n" + "test(Config, TestCase) ->\n" + " Dir = ?config(data_dir, Config),\n" + " OutDir = ?config(priv_dir, Config),\n" + " hipe_testsuite_driver:run(TestCase, Dir, OutDir)." + "\n\n", + [SuiteName ++ ?suite_suffix, Exports, TimeLimit, TestCases]). + +format_export(TestCases) -> + TL = [list_to_atom(atom_to_list(N)++"/1") || N <- TestCases], + TestCaseString = io_lib:format("-export(~p).", [TL]), + strip_quotes(lists:flatten(TestCaseString), []). + +strip_quotes([], Result) -> + lists:reverse(Result); +strip_quotes([$' |Rest], Result) -> + strip_quotes(Rest, Result); +strip_quotes([$\, |Rest], Result) -> + strip_quotes(Rest, [$\ , $\, |Result]); +strip_quotes([C|Rest], Result) -> + strip_quotes(Rest, [C|Result]). + +write_testcases(#suite{outputfile = OutputFile, testcases = TestCases}) -> + lists:foreach(fun (T) -> write_testcase(OutputFile, T) end, TestCases). + +write_testcase(OutputFile, TestCase) -> + io:format(OutputFile, + "~p(Config) ->\n" + " test(Config, ~p).\n\n", + [TestCase, TestCase]). + +-spec run(atom(), string(), string()) -> 'ok'. + +run(TestCase, Dir, _OutDir) -> + F = filename:join(Dir, atom_to_list(TestCase) ++ ".erl"), + {ok, TestCase} = compile:file(F), + ok = try TestCase:prepare_for_test() catch _:_ -> ok end, + %% DataFiles = try TestCase:datafiles() catch _:_ -> [] end, + %% lists:foreach(fun (DF) -> + %% Src = filename:join(Dir, DF), + %% Dst = filename:join(OutDir, DF), + %% {ok, _} = file:copy(Src, Dst) + %% end, DataFiles), + %% try + ok = TestCase:test(), + HiPEOpts = try TestCase:hipe_options() catch error:undef -> [] end, + {ok, TestCase} = hipe:c(TestCase, HiPEOpts), + ok = TestCase:test(), + ToLLVM = try TestCase:to_llvm() catch error:undef -> true end, + case ToLLVM andalso hipe:llvm_support_available() of + true -> + {ok, TestCase} = hipe:c(TestCase, [to_llvm|HiPEOpts]), + ok = TestCase:test(); + false -> ok + end. + %% after + %% lists:foreach(fun (DF) -> ok end, % = file:delete(DF) end, + %% [filename:join(OutDir, D) || D <- DataFiles]) + %% end. diff --git a/lib/hipe/test/maps_SUITE_data/maps_build_and_match_aliasing.erl b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_aliasing.erl new file mode 100644 index 0000000000..14d8320cdf --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_aliasing.erl @@ -0,0 +1,20 @@ +-module(maps_build_and_match_aliasing). +-export([test/0]). + +test() -> + M1 = id(#{a=>1,b=>2,c=>3,d=>4}), + #{c:=C1=_=_=C2} = M1, + true = C1 =:= C2, + #{a:=A,a:=A,a:=A,b:=B,b:=B} = M1, + #{a:=A,a:=A,a:=A,b:=B,b:=B,b:=2} = M1, + #{a:=A=1,a:=A,a:=A,b:=B=2,b:=B,b:=2} = M1, + #{c:=C1, c:=_, c:=3, c:=_, c:=C2} = M1, + #{c:=C=_=3=_=C} = M1, + + M2 = id(#{"a"=>1,"b"=>2,"c"=>3,"d"=>4}), + #{"a":=A2,"a":=A2,"a":=A2,"b":=B2,"b":=B2,"b":=2} = M2, + #{"a":=_,"a":=_,"a":=_,"b":=_,"b":=_,"b":=2} = M2, + ok. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_build_and_match_empty_val.erl b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_empty_val.erl new file mode 100644 index 0000000000..2abfa4e5b3 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_empty_val.erl @@ -0,0 +1,17 @@ +-module(maps_build_and_match_empty_val). +-export([test/0]). + +test() -> + F = fun(#{ "hi":=_,{1,2}:=_,1337:=_}) -> ok end, + ok = F(id(#{"hi"=>ok,{1,2}=>ok,1337=>ok})), + + %% error case + case (catch (F(id(#{"hi"=>ok})))) of + {'EXIT',{function_clause,_}} -> ok; + {'EXIT', {{case_clause,_},_}} -> {comment,inlined}; + Other -> + test_server:fail({no_match, Other}) + end. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_build_and_match_literals.erl b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_literals.erl new file mode 100644 index 0000000000..dc2c63fab2 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_literals.erl @@ -0,0 +1,40 @@ +-module(maps_build_and_match_literals). +-export([test/0]). + +test() -> + #{} = id(#{}), + #{1:=a} = id(#{1=>a}), + #{1:=a,2:=b} = id(#{1=>a,2=>b}), + #{1:=a,2:=b,3:="c"} = id(#{1=>a,2=>b,3=>"c"}), + #{1:=a,2:=b,3:="c","4":="d"} = id(#{1=>a,2=>b,3=>"c","4"=>"d"}), + #{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>} = + id(#{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>}), + #{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>,{"6",7}:="f"} = + id(#{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>,{"6",7}=>"f"}), + #{1:=a,2:=b,3:="c","4":="d",<<"5">>:=<<"e">>,{"6",7}:="f",8:=g} = + id(#{1=>a,2=>b,3=>"c","4"=>"d",<<"5">>=><<"e">>,{"6",7}=>"f",8=>g}), + + #{<<"hi all">> := 1} = id(#{<<"hi",32,"all">> => 1}), + + #{a:=X,a:=X=3,b:=4} = id(#{a=>3,b=>4}), % weird but ok =) + + #{ a:=#{ b:=#{c := third, b:=second}}, b:=first} = + id(#{ b=>first, a=>#{ b=>#{c => third, b=> second}}}), + + M = #{ map_1=>#{ map_2=>#{value_3 => third}, value_2=> second}, value_1=>first}, + M = #{ map_1:=#{ map_2:=#{value_3 := third}, value_2:= second}, value_1:=first} = + id(#{ map_1=>#{ map_2=>#{value_3 => third}, value_2=> second}, value_1=>first}), + + %% nil key + #{[]:=ok,1:=2} = id(#{[]=>ok,1=>2}), + + %% error case + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3,x:=2} = id(#{x=>3}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=2} = id(#{x=>3}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id({a,b,c}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id(#{y=>3}))), + {'EXIT',{{badmatch,_},_}} = (catch (#{x:=3} = id(#{x=>"three"}))), + ok. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_build_and_match_over_alloc.erl b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_over_alloc.erl new file mode 100644 index 0000000000..dae6f64e5f --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_over_alloc.erl @@ -0,0 +1,16 @@ +-module(maps_build_and_match_over_alloc). +-export([test/0]). + +test() -> + Ls = id([1,2,3]), + V0 = [a|Ls], + M0 = id(#{ "a" => V0 }), + #{ "a" := V1 } = M0, + V2 = id([c|Ls]), + M2 = id(#{ "a" => V2 }), + #{ "a" := V3 } = M2, + {[a,1,2,3],[c,1,2,3]} = id({V1,V3}), + ok. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_build_and_match_val.erl b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_val.erl new file mode 100644 index 0000000000..284f69e06c --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_build_and_match_val.erl @@ -0,0 +1,23 @@ +-module(maps_build_and_match_val). +-export([test/0]). + +test() -> + F = fun + (#{ "hi" := first, v := V}) -> {1,V}; + (#{ "hi" := second, v := V}) -> {2,V} + end, + + + {1,"hello"} = F(id(#{"hi"=>first,v=>"hello"})), + {2,"second"} = F(id(#{"hi"=>second,v=>"second"})), + + %% error case + case (catch (F(id(#{"hi"=>ok})))) of + {'EXIT',{function_clause,_}} -> ok; + {'EXIT', {{case_clause,_},_}} -> {comment,inlined}; + Other -> + test_server:fail({no_match, Other}) + end. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_expand_map_update.erl b/lib/hipe/test/maps_SUITE_data/maps_expand_map_update.erl new file mode 100644 index 0000000000..df0f77ea47 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_expand_map_update.erl @@ -0,0 +1,7 @@ +-module(maps_expand_map_update). +-export([test/0]). + +test() -> + M = #{<<"hello">> => <<"world">>}#{<<"hello">> := <<"les gens">>}, + #{<<"hello">> := <<"les gens">>} = M, + ok. diff --git a/lib/hipe/test/maps_SUITE_data/maps_export.erl b/lib/hipe/test/maps_SUITE_data/maps_export.erl new file mode 100644 index 0000000000..4d43fc96ed --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_export.erl @@ -0,0 +1,11 @@ +-module(maps_export). +-export([test/0]). + +test() -> + Raclette = id(#{}), + case brie of brie -> Fromage = Raclette end, + Raclette = Fromage#{}, + ok. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_get_map_elements.erl b/lib/hipe/test/maps_SUITE_data/maps_get_map_elements.erl new file mode 100644 index 0000000000..b2d749796a --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_get_map_elements.erl @@ -0,0 +1,23 @@ +%% -*- erlang-indent-level: 2 -*- +%%------------------------------------------------------------------------- +-module(maps_get_map_elements). + +-export([test/0]). + +test() -> + {A, B} = id({"hej", <<123>>}), + Map = maps:from_list([{a, A}, {b, B}]), + #{a := A, b := B} = id(Map), + false = test_pattern(Map), + true = test_pattern(#{b => 1, a => "hej"}), + case Map of + #{a := C, b := <<124>>} -> yay; + _ -> C = B, nay + end, + C = id(B), + ok. + +id(X) -> X. + +test_pattern(#{a := _, b := 1}) -> true; +test_pattern(#{}) -> false. diff --git a/lib/hipe/test/maps_SUITE_data/maps_guard_bifs.erl b/lib/hipe/test/maps_SUITE_data/maps_guard_bifs.erl new file mode 100644 index 0000000000..61a0eaa1e7 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_guard_bifs.erl @@ -0,0 +1,31 @@ +-module(maps_guard_bifs). +-export([test/0]). + +test() -> + true = map_guard_empty(), + true = map_guard_empty_2(), + true = map_guard_head(#{a=>1}), + false = map_guard_head([]), + true = map_guard_body(#{a=>1}), + false = map_guard_body({}), + true = map_guard_pattern(#{a=>1, <<"hi">> => "hi" }), + false = map_guard_pattern("list"), + true = map_guard_tautology(), + true = map_guard_ill_map_size(), + ok. + +map_guard_empty() when is_map(#{}); false -> true. + +map_guard_empty_2() when true; #{} andalso false -> true. + +map_guard_head(M) when is_map(M) -> true; +map_guard_head(_) -> false. + +map_guard_body(M) -> is_map(M). + +map_guard_pattern(#{}) -> true; +map_guard_pattern(_) -> false. + +map_guard_tautology() when #{} =:= #{}; true -> true. + +map_guard_ill_map_size() when true; map_size(0) -> true. diff --git a/lib/hipe/test/maps_SUITE_data/maps_guard_fun.erl b/lib/hipe/test/maps_SUITE_data/maps_guard_fun.erl new file mode 100644 index 0000000000..9f6eb3a04e --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_guard_fun.erl @@ -0,0 +1,36 @@ +-module(maps_guard_fun). +-export([test/0]). + +test() -> + F1 = fun + (#{s:=v,v:=V}) -> {v,V}; + (#{s:=t,v:={V,V}}) -> {t,V}; + (#{s:=l,v:=[V,V]}) -> {l,V} + end, + + F2 = fun + (#{s:=T,v:={V,V}}) -> {T,V}; + (#{s:=T,v:=[V,V]}) -> {T,V}; + (#{s:=T,v:=V}) -> {T,V} + end, + V = <<"hi">>, + + {v,V} = F1(#{s=>v,v=>V}), + {t,V} = F1(#{s=>t,v=>{V,V}}), + {l,V} = F1(#{s=>l,v=>[V,V]}), + + {v,V} = F2(#{s=>v,v=>V}), + {t,V} = F2(#{s=>t,v=>{V,V}}), + {l,V} = F2(#{s=>l,v=>[V,V]}), + + %% error case + case (catch F1(#{s=>none,v=>none})) of + {'EXIT', {function_clause,[{?MODULE,_,[#{s:=none,v:=none}],_}|_]}} -> ok; + {'EXIT', {function_clause,[{?MODULE,_,1,[#{s:=none,v:=none}]}|_]}} -> ok; + {'EXIT', {function_clause,[Frame|_]}} + when is_tuple(Frame), element(1, Frame) =:= ?MODULE -> + test_server:comment("Unexpected trace format, probably using HiPE"); + {'EXIT', {{case_clause,_},_}} -> {comment,inlined}; + Other -> + test_server:fail({no_match, Other}) + end. diff --git a/lib/hipe/test/maps_SUITE_data/maps_guard_receive.erl b/lib/hipe/test/maps_SUITE_data/maps_guard_receive.erl new file mode 100644 index 0000000000..f84ba19c86 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_guard_receive.erl @@ -0,0 +1,54 @@ +-module(maps_guard_receive). +-export([test/0]). + +test() -> + M0 = #{ id => 0 }, + Pid = spawn_link(fun() -> guard_receive_loop() end), + Big = 36893488147419103229, + B1 = <<"some text">>, + B2 = <<"was appended">>, + B3 = <<B1/binary, B2/binary>>, + + #{id:=1, res:=Big} = M1 = call(Pid, M0#{op=>sub,in=>{1 bsl 65, 3}}), + #{id:=2, res:=26} = M2 = call(Pid, M1#{op=>idiv,in=>{53,2}}), + #{id:=3, res:=832} = M3 = call(Pid, M2#{op=>imul,in=>{26,32}}), + #{id:=4, res:=4} = M4 = call(Pid, M3#{op=>add,in=>{1,3}}), + #{id:=5, res:=Big} = M5 = call(Pid, M4#{op=>sub,in=>{1 bsl 65, 3}}), + #{id:=6, res:=B3} = M6 = call(Pid, M5#{op=>"append",in=>{B1,B2}}), + #{id:=7, res:=4} = _ = call(Pid, M6#{op=>add,in=>{1,3}}), + + + %% update old maps and check id update + #{id:=2, res:=B3} = call(Pid, M1#{op=>"append",in=>{B1,B2}}), + #{id:=5, res:=99} = call(Pid, M4#{op=>add,in=>{33, 66}}), + + %% cleanup + done = call(Pid, done), + ok. + +call(Pid, M) -> + Pid ! {self(), M}, receive {Pid, Res} -> Res end. + +guard_receive_loop() -> + receive + {Pid, #{ id:=Id, op:="append", in:={X,Y}}=M} when is_binary(X), is_binary(Y) -> + Pid ! {self(), M#{ id=>Id+1, res=><<X/binary,Y/binary>>}}, + guard_receive_loop(); + {Pid, #{ id:=Id, op:=add, in:={X,Y}}} -> + Pid ! {self(), #{ id=>Id+1, res=>X+Y}}, + guard_receive_loop(); + {Pid, #{ id:=Id, op:=sub, in:={X,Y}}=M} -> + Pid ! {self(), M#{ id=>Id+1, res=>X-Y}}, + guard_receive_loop(); + {Pid, #{ id:=Id, op:=idiv, in:={X,Y}}=M} -> + Pid ! {self(), M#{ id=>Id+1, res=>X div Y}}, + guard_receive_loop(); + {Pid, #{ id:=Id, op:=imul, in:={X,Y}}=M} -> + Pid ! {self(), M#{ id=>Id+1, res=>X * Y}}, + guard_receive_loop(); + {Pid, done} -> + Pid ! {self(), done}; + {Pid, Other} -> + Pid ! {error, Other}, + guard_receive_loop() + end. diff --git a/lib/hipe/test/maps_SUITE_data/maps_guard_sequence.erl b/lib/hipe/test/maps_SUITE_data/maps_guard_sequence.erl new file mode 100644 index 0000000000..4eb18dcea1 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_guard_sequence.erl @@ -0,0 +1,35 @@ +-module(maps_guard_sequence). +-export([test/0]). + +test() -> + {1, "a"} = map_guard_sequence_1(#{seq=>1,val=>id("a")}), + {2, "b"} = map_guard_sequence_1(#{seq=>2,val=>id("b")}), + {3, "c"} = map_guard_sequence_1(#{seq=>3,val=>id("c")}), + {4, "d"} = map_guard_sequence_1(#{seq=>4,val=>id("d")}), + {5, "e"} = map_guard_sequence_1(#{seq=>5,val=>id("e")}), + + {1,M1} = map_guard_sequence_2(M1 = id(#{a=>3})), + {2,M2} = map_guard_sequence_2(M2 = id(#{a=>4, b=>4})), + {3,gg,M3} = map_guard_sequence_2(M3 = id(#{a=>gg, b=>4})), + {4,sc,sc,M4} = map_guard_sequence_2(M4 = id(#{a=>sc, b=>3, c=>sc2})), + {5,kk,kk,M5} = map_guard_sequence_2(M5 = id(#{a=>kk, b=>other, c=>sc2})), + + %% error case + {'EXIT',{function_clause,_}} = (catch map_guard_sequence_1(#{seq=>6,val=>id("e")})), + {'EXIT',{function_clause,_}} = (catch map_guard_sequence_2(#{b=>5})), + ok. + +map_guard_sequence_1(#{seq:=1=Seq, val:=Val}) -> {Seq,Val}; +map_guard_sequence_1(#{seq:=2=Seq, val:=Val}) -> {Seq,Val}; +map_guard_sequence_1(#{seq:=3=Seq, val:=Val}) -> {Seq,Val}; +map_guard_sequence_1(#{seq:=4=Seq, val:=Val}) -> {Seq,Val}; +map_guard_sequence_1(#{seq:=5=Seq, val:=Val}) -> {Seq,Val}. + +map_guard_sequence_2(#{ a:=3 }=M) -> {1, M}; +map_guard_sequence_2(#{ a:=4 }=M) -> {2, M}; +map_guard_sequence_2(#{ a:=X, a:=X, b:=4 }=M) -> {3,X,M}; +map_guard_sequence_2(#{ a:=X, a:=Y, b:=3 }=M) when X =:= Y -> {4,X,Y,M}; +map_guard_sequence_2(#{ a:=X, a:=Y }=M) when X =:= Y -> {5,X,Y,M}. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_guard_update.erl b/lib/hipe/test/maps_SUITE_data/maps_guard_update.erl new file mode 100644 index 0000000000..254c1c2984 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_guard_update.erl @@ -0,0 +1,14 @@ +-module(maps_guard_update). +-export([test/0]). + +test() -> + error = map_guard_update(#{},#{}), + first = map_guard_update(#{}, #{x=>first}), + second = map_guard_update(#{y=>old}, #{x=>second,y=>old}), + third = map_guard_update(#{x=>old,y=>old}, #{x=>third,y=>old}), + ok. + +map_guard_update(M1, M2) when M1#{x=>first} =:= M2 -> first; +map_guard_update(M1, M2) when M1#{x=>second} =:= M2 -> second; +map_guard_update(M1, M2) when M1#{x:=third} =:= M2 -> third; +map_guard_update(_, _) -> error. diff --git a/lib/hipe/test/maps_SUITE_data/maps_has_map_fields.erl b/lib/hipe/test/maps_SUITE_data/maps_has_map_fields.erl new file mode 100644 index 0000000000..61653aa519 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_has_map_fields.erl @@ -0,0 +1,46 @@ +%% -*- erlang-indent-level: 2 -*- +%%------------------------------------------------------------------------- +-module(maps_has_map_fields). + +-export([test/0]). + +test() -> + false = has_a_field(#{}), + false = has_a_field(#{b => 2}), + true = has_a_field(#{a => 3}), + true = has_a_field(#{b => c, a => false}), + + false = has_a_b_field(#{a => true}), + false = has_a_b_field(#{b => a}), + true = has_a_b_field(#{a => 1, b => 2}), + true = has_a_b_field(#{b => 3, a => 4}), + + false = has_binary_field(#{}), + false = has_binary_field(#{#{} => yay}), + true = has_binary_field(#{<<"true">> => false}), + + false = has_binary_but_no_map_field(#{}), + false = has_map_but_no_binary_field(#{}), + false = has_binary_but_no_map_field(#{#{} => 1}), + false = has_map_but_no_binary_field(#{<<"true">> => true}), + true = has_binary_but_no_map_field(#{<<"true">> => false}), + true = has_map_but_no_binary_field(#{#{} => 1}), + false = has_binary_but_no_map_field(#{<<"true">> => true, #{} => 1}), + false = has_map_but_no_binary_field(#{<<"true">> => true, #{} => 1}), + ok. + +has_a_field(#{a := _}) -> true; +has_a_field(#{}) -> false. + +has_a_b_field(#{a := _, b := _}) -> true; +has_a_b_field(#{}) -> false. + +has_binary_field(#{<<"true">> := _}) -> true; +has_binary_field(#{}) -> false. + +has_map_but_no_binary_field(#{<<"true">> := _}) -> false; +has_map_but_no_binary_field(#{} = M) -> maps:is_key(#{}, M). + +has_binary_but_no_map_field(#{<<"true">> := _} = M) -> + not maps:is_key(#{}, M); +has_binary_but_no_map_field(#{}) -> false. diff --git a/lib/hipe/test/maps_SUITE_data/maps_is_map.erl b/lib/hipe/test/maps_SUITE_data/maps_is_map.erl new file mode 100644 index 0000000000..e84f4b8c44 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_is_map.erl @@ -0,0 +1,24 @@ +%% -*- erlang-indent-level: 2 -*- +%%------------------------------------------------------------------------- +-module(maps_is_map). + +-export([test/0]). + +test() -> + true = test_is_map(#{}), + false = test_is_map(<<"hej">>), + true = test_is_map_guard(#{a => b}), + false = test_is_map_guard(3), + true = test_is_map_with_binary_guard(#{"a" => <<"b">>}), + false = test_is_map_with_binary_guard(12), + ok. + +test_is_map(X) -> + is_map(X). + +test_is_map_guard(Map) when is_map(Map) -> true; +test_is_map_guard(_) -> false. + +test_is_map_with_binary_guard(B) when is_binary(B) -> false; +test_is_map_with_binary_guard(#{}) -> true; +test_is_map_with_binary_guard(_) -> false. diff --git a/lib/hipe/test/maps_SUITE_data/maps_list_comprehension.erl b/lib/hipe/test/maps_SUITE_data/maps_list_comprehension.erl new file mode 100644 index 0000000000..ad2c726d65 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_list_comprehension.erl @@ -0,0 +1,6 @@ +-module(maps_list_comprehension). +-export([test/0]). + +test() -> + [#{k:=1},#{k:=2},#{k:=3}] = [#{k=>I} || I <- [1,2,3]], + ok. diff --git a/lib/hipe/test/maps_SUITE_data/maps_map_size.erl b/lib/hipe/test/maps_SUITE_data/maps_map_size.erl new file mode 100644 index 0000000000..3cd2d90dfb --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_map_size.erl @@ -0,0 +1,29 @@ +-module(maps_map_size). +-export([test/0]). + +test() -> + 0 = map_size(id(#{})), + 1 = map_size(id(#{a=>1})), + 1 = map_size(id(#{a=>"wat"})), + 2 = map_size(id(#{a=>1, b=>2})), + 3 = map_size(id(#{a=>1, b=>2, b=>"3","33"=><<"n">>})), + + true = map_is_size(#{a=>1}, 1), + true = map_is_size(#{a=>1, a=>2}, 1), + M = #{ "a" => 1, "b" => 2}, + true = map_is_size(M, 2), + false = map_is_size(M, 3), + true = map_is_size(M#{ "a" => 2}, 2), + false = map_is_size(M#{ "c" => 2}, 2), + + %% Error cases. + {'EXIT',{{badmap,[]},_}} = (catch map_size([])), + {'EXIT',{{badmap,<<1,2,3>>},_}} = (catch map_size(<<1,2,3>>)), + {'EXIT',{{badmap,1},_}} = (catch map_size(1)), + ok. + +map_is_size(M,N) when map_size(M) =:= N -> true; +map_is_size(_,_) -> false. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_map_sort_literals.erl b/lib/hipe/test/maps_SUITE_data/maps_map_sort_literals.erl new file mode 100644 index 0000000000..ccacbfe5c8 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_map_sort_literals.erl @@ -0,0 +1,42 @@ +-module(maps_map_sort_literals). +-export([test/0]). + +test() -> + % test relation + + %% size order + true = #{ a => 1, b => 2} < id(#{ a => 1, b => 1, c => 1}), + true = #{ b => 1, a => 1} < id(#{ c => 1, a => 1, b => 1}), + false = #{ c => 1, b => 1, a => 1} < id(#{ c => 1, a => 1}), + + %% key order + true = #{ a => 1 } < id(#{ b => 1}), + false = #{ b => 1 } < id(#{ a => 1}), + true = #{ a => 1, b => 1, c => 1 } < id(#{ b => 1, c => 1, d => 1}), + true = #{ b => 1, c => 1, d => 1 } > id(#{ a => 1, b => 1, c => 1}), + true = #{ c => 1, b => 1, a => 1 } < id(#{ b => 1, c => 1, d => 1}), + true = #{ "a" => 1 } < id(#{ <<"a">> => 1}), + false = #{ <<"a">> => 1 } < id(#{ "a" => 1}), + true = #{ 1 => 1 } < id(#{ 1.0 => 1}), + false = #{ 1.0 => 1 } < id(#{ 1 => 1}), + + %% value order + true = #{ a => 1 } < id(#{ a => 2}), + false = #{ a => 2 } < id(#{ a => 1}), + false = #{ a => 2, b => 1 } < id(#{ a => 1, b => 3}), + true = #{ a => 1, b => 1 } < id(#{ a => 1, b => 3}), + false = #{ a => 1 } < id(#{ a => 1.0}), + false = #{ a => 1.0 } < id(#{ a => 1}), + + true = #{ "a" => "hi", b => 134 } == id(#{ b => 134,"a" => "hi"}), + + %% lists:sort + + SortVs = [#{"a"=>1},#{a=>2},#{1=>3},#{<<"a">>=>4}], + [#{1:=ok},#{a:=ok},#{"a":=ok},#{<<"a">>:=ok}] = lists:sort([#{"a"=>ok},#{a=>ok},#{1=>ok},#{<<"a">>=>ok}]), + [#{1:=3},#{a:=2},#{"a":=1},#{<<"a">>:=4}] = lists:sort(SortVs), + [#{1:=3},#{a:=2},#{"a":=1},#{<<"a">>:=4}] = lists:sort(lists:reverse(SortVs)), + ok. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_match_and_update_literals.erl b/lib/hipe/test/maps_SUITE_data/maps_match_and_update_literals.erl new file mode 100644 index 0000000000..29a6a29290 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_match_and_update_literals.erl @@ -0,0 +1,24 @@ +-module(maps_match_and_update_literals). +-export([test/0]). + +test() -> + Map = #{x=>0,y=>"untouched",z=>"also untouched",q=>1}, + #{x:=16,q:=21,y:="untouched",z:="also untouched"} = loop_match_and_update_literals_x_q(Map, [ + {1,2},{3,4},{5,6},{7,8} + ]), + M0 = id(#{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}), + M1 = id(#{}), + M2 = M1#{ "hi" => "hello", int => 3, <<"key">> => <<"value">>, + 4 => number, 18446744073709551629 => wat}, + M0 = M2, + + #{ 4 := another_number, int := 3 } = M2#{ 4 => another_number }, + ok. + +loop_match_and_update_literals_x_q(Map, []) -> Map; +loop_match_and_update_literals_x_q(#{q:=Q0,x:=X0} = Map, [{X,Q}|Vs]) -> + loop_match_and_update_literals_x_q(Map#{q=>Q0+Q,x=>X0+X},Vs). + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_put_map_assoc.erl b/lib/hipe/test/maps_SUITE_data/maps_put_map_assoc.erl new file mode 100644 index 0000000000..2fe4f204d1 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_put_map_assoc.erl @@ -0,0 +1,23 @@ +%% -*- erlang-indent-level: 2 -*- +%%------------------------------------------------------------------------- +-module(maps_put_map_assoc). + +-export([test/0]). + +test() -> + true = assoc_guard(#{}), + false = assoc_guard(not_a_map), + #{a := true} = assoc_update(#{}), + {'EXIT', {{badmap, not_a_map}, [{?MODULE, assoc_update, 1, _}|_]}} + = (catch assoc_update(not_a_map)), + ok = assoc_guard_clause(#{}), + {'EXIT', {function_clause, [{?MODULE, assoc_guard_clause, _, _}|_]}} + = (catch assoc_guard_clause(not_a_map)), + ok. + +assoc_guard(M) when is_map(M#{a => b}) -> true; +assoc_guard(_) -> false. + +assoc_update(M) -> M#{a => true}. + +assoc_guard_clause(M) when is_map(M#{a => 3}) -> ok. diff --git a/lib/hipe/test/maps_SUITE_data/maps_put_map_exact.erl b/lib/hipe/test/maps_SUITE_data/maps_put_map_exact.erl new file mode 100644 index 0000000000..3c85289a36 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_put_map_exact.erl @@ -0,0 +1,28 @@ +%% -*- erlang-indent-level: 2 -*- +%%------------------------------------------------------------------------- +-module(maps_put_map_exact). + +-export([test/0]). + +test() -> + false = exact_guard(#{b => a}), + false = exact_guard(not_a_map), + true = exact_guard(#{a => false}), + #{a := true} = exact_update(#{a => false}), + {'EXIT', {{badmap, not_a_map}, [{?MODULE, exact_update, 1, _}|_]}} + = (catch exact_update(not_a_map)), + {'EXIT', {{badkey, a}, [{?MODULE, exact_update, 1, _}|_]}} + = (catch exact_update(#{})), + ok = exact_guard_clause(#{a => yes}), + {'EXIT', {function_clause, [{?MODULE, exact_guard_clause, _, _}|_]}} + = (catch exact_guard_clause(#{})), + {'EXIT', {function_clause, [{?MODULE, exact_guard_clause, _, _}|_]}} + = (catch exact_guard_clause(not_a_map)), + ok. + +exact_guard(M) when is_map(M#{a := b}) -> true; +exact_guard(_) -> false. + +exact_update(M) -> M#{a := true}. + +exact_guard_clause(M) when is_map(M#{a := 42}) -> ok. diff --git a/lib/hipe/test/maps_SUITE_data/maps_update_assoc.erl b/lib/hipe/test/maps_SUITE_data/maps_update_assoc.erl new file mode 100644 index 0000000000..99228a1927 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_update_assoc.erl @@ -0,0 +1,22 @@ +-module(maps_update_assoc). +-export([test/0]). + +test() -> + M0 = id(#{1=>a,2=>b,3.0=>c,4=>d,5=>e}), + + M1 = M0#{1=>42,2=>100,4=>[a,b,c]}, + #{1:=42,2:=100,3.0:=c,4:=[a,b,c],5:=e} = M1, + #{1:=42,2:=b,4:=d,5:=e,2.0:=100,3.0:=c,4.0:=[a,b,c]} = M0#{1.0=>float,1:=42,2.0=>wrong,2.0=>100,4.0=>[a,b,c]}, + + M2 = M0#{3.0=>new}, + #{1:=a,2:=b,3.0:=new,4:=d,5:=e} = M2, + M2 = M0#{3.0:=wrong,3.0=>new}, + + %% Errors cases. + BadMap = id(badmap), + {'EXIT',{{badmap,badmap},_}} = (catch BadMap#{nonexisting=>val}), + + ok. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_update_exact.erl b/lib/hipe/test/maps_SUITE_data/maps_update_exact.erl new file mode 100644 index 0000000000..1c38820a7c --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_update_exact.erl @@ -0,0 +1,32 @@ +-module(maps_update_exact). +-export([test/0]). + +test() -> + M0 = id(#{1=>a,2=>b,3.0=>c,4=>d,5=>e}), + + M1 = M0#{1:=42,2:=100,4:=[a,b,c]}, + #{1:=42,2:=100,3.0:=c,4:=[a,b,c],5:=e} = M1, + M1 = M0#{1:=wrong,1=>42,2=>wrong,2:=100,4:=[a,b,c]}, + + M2 = M0#{3.0:=new}, + #{1:=a,2:=b,3.0:=new,4:=d,5:=e} = M2, + M2 = M0#{3.0=>wrong,3.0:=new}, + true = M2 =/= M0#{3=>right,3.0:=new}, + #{ 3 := right, 3.0 := new } = M0#{3=>right,3.0:=new}, + + M3 = id(#{ 1 => val}), + #{1 := update2,1.0 := new_val4} = M3#{ + 1.0 => new_val1, 1 := update, 1=> update3, + 1 := update2, 1.0 := new_val2, 1.0 => new_val3, + 1.0 => new_val4 }, + + %% Errors cases. + {'EXIT',{{badmap,nil},_}} = (catch ((id(nil))#{ a := b })), + {'EXIT',{{badkey,nonexisting},_}} = (catch M0#{nonexisting:=val}), + {'EXIT',{{badkey,_},_}} = (catch M0#{1.0:=v,1.0=>v2}), + {'EXIT',{{badkey,_},_}} = (catch M0#{42.0:=v,42:=v2}), + {'EXIT',{{badkey,_},_}} = (catch M0#{42=>v1,42.0:=v2,42:=v3}), + ok. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_update_literals.erl b/lib/hipe/test/maps_SUITE_data/maps_update_literals.erl new file mode 100644 index 0000000000..87aea3d8e1 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_update_literals.erl @@ -0,0 +1,13 @@ +-module(maps_update_literals). +-export([test/0]). + +test() -> + Map = #{x=>1,y=>2,z=>3,q=>4}, + #{x:="d",q:="4"} = loop_update_literals_x_q(Map, [ + {"a","1"},{"b","2"},{"c","3"},{"d","4"} + ]), + ok. + +loop_update_literals_x_q(Map, []) -> Map; +loop_update_literals_x_q(Map, [{X,Q}|Vs]) -> + loop_update_literals_x_q(Map#{q=>Q,x=>X},Vs). diff --git a/lib/hipe/test/maps_SUITE_data/maps_update_map_expressions.erl b/lib/hipe/test/maps_SUITE_data/maps_update_map_expressions.erl new file mode 100644 index 0000000000..213fc33d97 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_update_map_expressions.erl @@ -0,0 +1,32 @@ +-module(maps_update_map_expressions). +-export([test/0]). + +test() -> + M = maps:new(), + X = id(fondue), + M1 = #{ a := 1 } = M#{a => 1}, + #{ b := {X} } = M1#{ a := 1, b => {X} }, + + #{ b := 2 } = (maps:new())#{ b => 2 }, + + #{ a :=42, b:=42, c:=42 } = (maps:from_list([{a,1},{b,2},{c,3}]))#{ a := 42, b := 42, c := 42 }, + #{ "a" :=1, "b":=42, "c":=42 } = (maps:from_list([{"a",1},{"b",2}]))#{ "b" := 42, "c" => 42 }, + + %% Test need to be in a fun. + %% This tests that let expr optimisation in sys_core_fold + %% covers maps correctly. + F = fun() -> + M0 = id(#{ "a" => [1,2,3] }), + #{ "a" := _ } = M0, + M0#{ "a" := b } + end, + + #{ "a" := b } = F(), + + %% Error cases. + {'EXIT',{{badmap,<<>>},_}} = (catch (id(<<>>))#{ a := 42, b => 2 }), + {'EXIT',{{badmap,[]},_}} = (catch (id([]))#{ a := 42, b => 2 }), + ok. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_update_values.erl b/lib/hipe/test/maps_SUITE_data/maps_update_values.erl new file mode 100644 index 0000000000..bbad5ac19e --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_update_values.erl @@ -0,0 +1,28 @@ +-module(maps_update_values). +-export([test/0]). + +test() -> + V0 = id(1337), + M0 = #{ a => 1, val => V0}, + V1 = get_val(M0), + M1 = M0#{ val := [V0,V1], "wazzup" => 42 }, + [1337, {some_val, 1337}] = get_val(M1), + + N = 110, + List = [{[I,1,2,3,I],{1,2,3,"wat",I}}|| I <- lists:seq(1,N)], + + {_,_,#{val2 := {1,2,3,"wat",N}, val1 := [N,1,2,3,N]}} = lists:foldl(fun + ({V2,V3},{Old2,Old3,Mi}) -> + ok = check_val(Mi,Old2,Old3), + #{ val1 := Old2, val2 := Old3 } = Mi, + {V2,V3, Mi#{ val1 := id(V2), val2 := V1, val2 => id(V3)}} + end, {none, none, #{val1=>none,val2=>none}},List), + ok. + +get_val(#{ "wazzup" := _, val := V}) -> V; +get_val(#{ val := V }) -> {some_val, V}. + +check_val(#{val1:=V1, val2:=V2},V1,V2) -> ok. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_warn_pair_key_overloaded.erl b/lib/hipe/test/maps_SUITE_data/maps_warn_pair_key_overloaded.erl new file mode 100644 index 0000000000..76b2a91f94 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_warn_pair_key_overloaded.erl @@ -0,0 +1,27 @@ +-module(maps_warn_pair_key_overloaded). +-export([test/0]). + +test() -> + #{ "hi1" := 42 } = id(#{ "hi1" => 1, "hi1" => 42 }), + + #{ "hi1" := 1337, "hi2" := [2], "hi3" := 3 } = id(#{ + "hi1" => erlang:atom_to_binary(?MODULE,utf8), + "hi1" => erlang:binary_to_atom(<<"wazzup">>,utf8), + "hi1" => erlang:binary_to_float(<<"3.1416">>), + "hi1" => erlang:float_to_binary(3.1416), + "hi2" => erlang:pid_to_list(self()), + "hi3" => erlang:float_to_binary(3.1416), + "hi2" => lists:subtract([1,2],[1]), + "hi3" => +3, + "hi1" => erlang:min(1,2), + "hi1" => erlang:hash({1,2},35), + "hi1" => erlang:phash({1,2},33), + "hi1" => erlang:phash2({1,2},34), + "hi1" => erlang:integer_to_binary(1337), + "hi1" => erlang:binary_to_integer(<<"1337">>), + "hi4" => erlang:float_to_binary(3.1416) + }), + ok. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/maps_SUITE_data/maps_warn_useless_build.erl b/lib/hipe/test/maps_SUITE_data/maps_warn_useless_build.erl new file mode 100644 index 0000000000..6cb0366314 --- /dev/null +++ b/lib/hipe/test/maps_SUITE_data/maps_warn_useless_build.erl @@ -0,0 +1,9 @@ +-module(maps_warn_useless_build). +-export([test/0]). + +test() -> + [#{ a => id(I)} || I <- [1,2,3]], + ok. + +%% Use this function to avoid compile-time evaluation of an expression. +id(I) -> I. diff --git a/lib/hipe/test/opt_verify_SUITE.erl b/lib/hipe/test/opt_verify_SUITE.erl new file mode 100644 index 0000000000..61952e81d7 --- /dev/null +++ b/lib/hipe/test/opt_verify_SUITE.erl @@ -0,0 +1,62 @@ +-module(opt_verify_SUITE). + +-compile([export_all]). + +all() -> + [call_elim]. + +groups() -> + []. + +init_per_suite(Config) -> + case erlang:system_info(hipe_architecture) of + undefined -> {skip, "HiPE not available or enabled"}; + _ -> Config + end. + +end_per_suite(_Config) -> + ok. + +init_per_group(_GroupName, Config) -> + Config. + +end_per_group(_GroupName, Config) -> + Config. + +call_elim_test_file(Config, FileName, Option) -> + PrivDir = test_server:lookup_config(priv_dir, Config), + TempOut = test_server:temp_name(filename:join(PrivDir, "call_elim_out")), + {ok, TestCase} = compile:file(FileName), + {ok, TestCase} = hipe:c(TestCase, [Option, {pp_range_icode, {file, TempOut}}]), + {ok, Icode} = file:read_file(TempOut), + ok = file:delete(TempOut), + Icode. + +substring_count(Icode, Substring) -> + substring_count(Icode, Substring, 0). +substring_count(Icode, Substring, N) -> + case string:str(Icode, Substring) of + 0 -> N; + I -> substring_count(lists:nthtail(I, Icode), Substring, N+1) + end. + +call_elim() -> + [{doc, "Test that the call elimination optimization pass is ok"}]. +call_elim(Config) -> + DataDir = test_server:lookup_config(data_dir, Config), + F1 = filename:join(DataDir, "call_elim_test.erl"), + Icode1 = call_elim_test_file(Config, F1, icode_call_elim), + 0 = substring_count(binary:bin_to_list(Icode1), "is_key"), + Icode2 = call_elim_test_file(Config, F1, no_icode_call_elim), + true = (0 /= substring_count(binary:bin_to_list(Icode2), "is_key")), + F2 = filename:join(DataDir, "call_elim_test_branches_no_opt_poss.erl"), + Icode3 = call_elim_test_file(Config, F2, icode_call_elim), + 3 = substring_count(binary:bin_to_list(Icode3), "is_key"), + Icode4 = call_elim_test_file(Config, F2, no_icode_call_elim), + 3 = substring_count(binary:bin_to_list(Icode4), "is_key"), + F3 = filename:join(DataDir, "call_elim_test_branches_opt_poss.erl"), + Icode5 = call_elim_test_file(Config, F3, icode_call_elim), + 0 = substring_count(binary:bin_to_list(Icode5), "is_key"), + Icode6 = call_elim_test_file(Config, F3, no_icode_call_elim), + 3 = substring_count(binary:bin_to_list(Icode6), "is_key"), + ok. diff --git a/lib/hipe/test/opt_verify_SUITE_data/call_elim_test.erl b/lib/hipe/test/opt_verify_SUITE_data/call_elim_test.erl new file mode 100644 index 0000000000..8b725f8ffe --- /dev/null +++ b/lib/hipe/test/opt_verify_SUITE_data/call_elim_test.erl @@ -0,0 +1,12 @@ +-module(call_elim_test). + +-export([test/0]). + +test() -> + true = has_1_field(#{1=>true}), + true = has_1_field(#{1=>"hej", b=>2}), + true = has_1_field(#{b=>3, 1=>4}), + ok. + +has_1_field(#{1:=_}) -> true; +has_1_field(#{}) -> false. diff --git a/lib/hipe/test/opt_verify_SUITE_data/call_elim_test_branches_no_opt_poss.erl b/lib/hipe/test/opt_verify_SUITE_data/call_elim_test_branches_no_opt_poss.erl new file mode 100644 index 0000000000..7ffae86797 --- /dev/null +++ b/lib/hipe/test/opt_verify_SUITE_data/call_elim_test_branches_no_opt_poss.erl @@ -0,0 +1,32 @@ +-module(call_elim_test_branches_no_opt_poss). + +-export([test/1]). + +test(A) -> + if A > 0 -> + false = has_a_field(#{b=>true}), + true = has_a_field(#{b=>1, a=>"2"}), + false = has_a_field(#{b=>5, c=>4}), + false = has_tuple_field(#{{ab, 2}=><<"qq">>, 1 =>0}), + false = has_tuple_field(#{up =>down, {ab, 2}=>[]}), + false = has_tuple_field(#{{ab, 2}=>42}); + A =< 0 -> + true = has_a_field(#{a=>q, 'A' =>nej}), + true = has_a_field(#{a=>"hej", false=>true}), + true = has_a_field(#{a=>3}), + true = has_tuple_field(#{{ab, 1}=>q, 'A' =>nej}), + true = has_tuple_field(#{{ab, 1}=>"hej", false=>true}), + true = has_tuple_field(#{{ab, 1}=>3}) + end, + true = has_nil_field(#{[] =>3, b=>"seven"}), + true = has_nil_field(#{"seventeen"=>17}), + ok. + +has_tuple_field(#{{ab, 1}:=_}) -> true; +has_tuple_field(#{}) -> false. + +has_a_field(#{a:=_}) -> true; +has_a_field(#{}) -> false. + +has_nil_field(#{[]:=_}) -> true; +has_nil_field(#{}) -> false. diff --git a/lib/hipe/test/opt_verify_SUITE_data/call_elim_test_branches_opt_poss.erl b/lib/hipe/test/opt_verify_SUITE_data/call_elim_test_branches_opt_poss.erl new file mode 100644 index 0000000000..c8ddfa1e75 --- /dev/null +++ b/lib/hipe/test/opt_verify_SUITE_data/call_elim_test_branches_opt_poss.erl @@ -0,0 +1,32 @@ +-module(call_elim_test_branches_opt_poss). + +-export([test/1]). + +test(A) -> + if A > 0 -> + true = has_a_field(#{a=>true}), + true = has_a_field(#{b=>1, a=>"2"}), + true = has_a_field(#{a=>5, c=>4}), + true = has_tuple_field(#{{ab, 1}=><<"qq">>, 1 =>0}), + true = has_tuple_field(#{up =>down, {ab, 1}=>[]}), + true = has_tuple_field(#{{ab, 1}=>42}); + A =< 0 -> + true = has_a_field(#{a=>q, 'A' =>nej}), + true = has_a_field(#{a=>"hej", false=>true}), + true = has_a_field(#{a=>3}), + true = has_tuple_field(#{{ab, 1}=>q, 'A' =>nej}), + true = has_tuple_field(#{{ab, 1}=>"hej", false=>true}), + true = has_tuple_field(#{{ab, 1}=>3}) + end, + true = has_nil_field(#{[] =>3, b =>"seven"}), + true = has_nil_field(#{"seventeen"=>17, []=>nil}), + ok. + +has_tuple_field(#{{ab, 1}:=_}) -> true; +has_tuple_field(#{}) -> false. + +has_a_field(#{a:=_}) -> true; +has_a_field(#{}) -> false. + +has_nil_field(#{[]:=_}) -> true; +has_nil_field(#{}) -> false. diff --git a/lib/hipe/test/sanity_SUITE_data/sanity_comp_timeout.erl b/lib/hipe/test/sanity_SUITE_data/sanity_comp_timeout.erl new file mode 100644 index 0000000000..9f0830574f --- /dev/null +++ b/lib/hipe/test/sanity_SUITE_data/sanity_comp_timeout.erl @@ -0,0 +1,28 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%---------------------------------------------------------------------- +%%% Author: Kostis Sagonas +%%% +%%% Tests that when the native code compilation times out or gets killed +%%% for some other reason, the parent process does not also get killed. +%%% +%%% Problem discovered by Bjorn G. on 1/12/2003 and fixed by Kostis. +%%%---------------------------------------------------------------------- + +-module(sanity_comp_timeout). + +-export([test/0, to_llvm/0]). + +test() -> + ok = write_dummy_mod(), + error_logger:tty(false), % disable printouts of error reports + Self = self(), % get the parent process + c:c(dummy_mod, [native, {hipe, [{timeout, 1}]}]), % This will kill the process + Self = self(), % make sure the parent process stays the same + ok. + +to_llvm() -> false. + +write_dummy_mod() -> + Prog = <<"-module(dummy_mod).\n-export([test/0]).\ntest() -> ok.\n">>, + ok = file:write_file("dummy_mod.erl", Prog). + diff --git a/lib/hipe/test/sanity_SUITE_data/sanity_no_zombies.erl b/lib/hipe/test/sanity_SUITE_data/sanity_no_zombies.erl new file mode 100644 index 0000000000..87e746042e --- /dev/null +++ b/lib/hipe/test/sanity_SUITE_data/sanity_no_zombies.erl @@ -0,0 +1,21 @@ +%%% -*- erlang-indent-level: 2 -*- +%%%---------------------------------------------------------------------- +%%% Author: Per Gustafsson +%%% +%%% Checks that HiPE's concurrent compilation does not leave any zombie +%%% processes around after compilation has finished. +%%% +%%% This was a bug reported on erlang-bugs (Oct 25, 2007). +%%%---------------------------------------------------------------------- + +-module(sanity_no_zombies). + +-export([test/0, to_llvm/0]). + +test() -> + L = length(processes()), + hipe:c(?MODULE, [concurrent_comp]), % force concurrent compilation + L = length(processes()), + ok. + +to_llvm() -> false. diff --git a/lib/hipe/tools/Makefile b/lib/hipe/tools/Makefile index 3ce8ad5dd7..7a62896c31 100644 --- a/lib/hipe/tools/Makefile +++ b/lib/hipe/tools/Makefile @@ -1,18 +1,19 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2002-2012. All Rights Reserved. +# Copyright Ericsson AB 2002-2016. All Rights Reserved. # -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at # -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. # # %CopyrightEnd% # @@ -42,7 +43,7 @@ RELSYSDIR = $(RELEASE_PATH)/lib/hipe-$(VSN) # ---------------------------------------------------- # Target Specs # ---------------------------------------------------- -MODULES = hipe_tool hipe_profile hipe_jit +MODULES = hipe_profile hipe_jit # hipe_timer HRL_FILES= @@ -64,7 +65,7 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += +warn_exported_vars +warn_missing_spec +warn_untyped_record +ERL_COMPILE_FLAGS += -Werror +warn_export_vars +warn_missing_spec +warn_untyped_record # ---------------------------------------------------- # Targets @@ -110,5 +111,4 @@ realclean: clean # ---------------------------------------------------- $(EBIN)/hipe_ceach.beam: ../main/hipe.hrl -$(EBIN)/hipe_tool.beam: ../main/hipe.hrl diff --git a/lib/hipe/tools/hipe_jit.erl b/lib/hipe/tools/hipe_jit.erl index 0ac84388ae..ffe0e440e9 100644 --- a/lib/hipe/tools/hipe_jit.erl +++ b/lib/hipe/tools/hipe_jit.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% Copyright Ericsson AB 2002-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/tools/hipe_profile.erl b/lib/hipe/tools/hipe_profile.erl index ea6b1fb42c..9b9c0d6aad 100644 --- a/lib/hipe/tools/hipe_profile.erl +++ b/lib/hipe/tools/hipe_profile.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2011. All Rights Reserved. +%% Copyright Ericsson AB 2002-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/tools/hipe_timer.erl b/lib/hipe/tools/hipe_timer.erl index 03cc358f17..72aa25d440 100644 --- a/lib/hipe/tools/hipe_timer.erl +++ b/lib/hipe/tools/hipe_timer.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2002-2009. All Rights Reserved. +%% Copyright Ericsson AB 2002-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -46,27 +47,27 @@ tr(F) -> {R,{WT-EWT,(RT-ERT)/1000}}. empty_time() -> - {WT1,WT2,WT3} = erlang:now(), + WTA = erlang:monotonic_time(), {A,_} = erlang:statistics(runtime), - {WT12,WT22,WT32} = erlang:now(), + WTB = erlang:monotonic_time(), {B,_} = erlang:statistics(runtime), - {(WT12-WT1)*1000000+(WT22-WT2)+(WT32-WT3)/1000000,B-A}. + {(WTB-WTA)/erlang:convert_time_unit(1, seconds, native),B-A}. time(F) -> - {WT1,WT2,WT3} = erlang:now(), + WTA = erlang:monotonic_time(), {A,_} = erlang:statistics(runtime), F(), - {WT12,WT22,WT32} = erlang:now(), + WTB = erlang:monotonic_time(), {B,_} = erlang:statistics(runtime), - {(WT12-WT1)*1000000+(WT22-WT2)+(WT32-WT3)/1000000,B-A}. + {(WTB-WTA)/erlang:convert_time_unit(1, seconds, native),B-A}. timer(F) -> - {WT1,WT2,WT3} = erlang:now(), + WTA = erlang:monotonic_time(), {A,_} = erlang:statistics(runtime), R = F(), - {WT12,WT22,WT32} = erlang:now(), + WTB = erlang:monotonic_time(), {B,_} = erlang:statistics(runtime), - {R,{(WT12-WT1)*1000000+(WT22-WT2)+(WT32-WT3)/1000000,B-A}}. + {R,{(WTB-WTA)/erlang:convert_time_unit(1, seconds, native),B-A}}. advanced(_Fun, I) when I < 2 -> false; advanced(Fun, Iterations) -> diff --git a/lib/hipe/tools/hipe_tool.erl b/lib/hipe/tools/hipe_tool.erl deleted file mode 100644 index efcf073efa..0000000000 --- a/lib/hipe/tools/hipe_tool.erl +++ /dev/null @@ -1,525 +0,0 @@ -%% -*- erlang-indent-level: 2 -*- -%% -%% %CopyrightBegin% -%% -%% Copyright Ericsson AB 2002-2012. All Rights Reserved. -%% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. -%% -%% %CopyrightEnd% -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -%% Copyright (c) 2002 by Erik Johansson. -%% ==================================================================== -%% Module : hipe_tool -%% Purpose : -%% Notes : -%% History : * 2002-03-13 Erik Johansson ([email protected]): Created. -%% ==================================================================== -%% Exports : -%% -%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% - --module(hipe_tool). --compile([{nowarn_deprecated_function,{gs,button,3}}, - {nowarn_deprecated_function,{gs,config,2}}, - {nowarn_deprecated_function,{gs,destroy,1}}, - {nowarn_deprecated_function,{gs,editor,3}}, - {nowarn_deprecated_function,{gs,label,3}}, - {nowarn_deprecated_function,{gs,listbox,3}}, - {nowarn_deprecated_function,{gs,menu,3}}, - {nowarn_deprecated_function,{gs,menubar,3}}, - {nowarn_deprecated_function,{gs,menubutton,3}}, - {nowarn_deprecated_function,{gs,menuitem,2}}, - {nowarn_deprecated_function,{gs,start,0}}, - {nowarn_deprecated_function,{gs,window,3}}]). - --export([start/0]). - -%%--------------------------------------------------------------------- - --include("../main/hipe.hrl"). - -%%--------------------------------------------------------------------- - --define(WINDOW_WIDTH, 920). --define(WINDOW_HEIGHT, 460). --define(DEFAULT_BG_COLOR, {217,217,217}). --define(POLL_INTERVAL, 5000). --define(FONT, {screen, 12}). --define(HEADER_FONT, {screen, [bold], 12}). --define(NORMAL_FG_COLOR, {0,0,0}). - -%%--------------------------------------------------------------------- - --type fa() :: {atom(), arity()}. % {Fun,Arity} --type fa_address() :: {atom(), arity(), non_neg_integer()}. % {F,A,Address} - -%%--------------------------------------------------------------------- - --record(state, {win_created = false :: boolean(), - mindex = 0 :: integer(), - mod :: atom(), - funs = [] :: [fa()], - mods = [] :: [atom()], - options = [o2] :: comp_options(), - compiling = false :: 'false' | pid() - }). - -%%--------------------------------------------------------------------- - --spec start() -> pid(). - -start() -> - spawn(fun () -> init() end). - -init() -> - process_flag(trap_exit, true), - gs:start(), - S = init_window(#state{}), - loop(S). - --spec loop(#state{}) -> no_return(). - -loop(State) -> - receive - {gs, code_listbox, click, Data, [Idx, Txt | _]} -> - NewState = update_module_box(State,Idx,Data,Txt), - loop(NewState); - {gs, module_listbox, click, Data, [Idx, _Txt | _]} -> - NewState = update_fun(State,Idx,Data), - loop(NewState); - {gs, compmod, click, _, _} -> - loop(compile(State)); - {gs, prof, click, [], ["Turn off\nProfiling"]} -> - hipe_profile:prof_module_off(State#state.mod), - loop(update_module_box(State,State#state.mindex,State#state.mods,"")); - {gs, prof, click, [], _} -> - hipe_profile:prof_module(State#state.mod), - loop(update_module_box(State,State#state.mindex,State#state.mods,"")); - {gs, win, configure, _, _} -> - gs:config(win, [{width, ?WINDOW_WIDTH}, {height, ?WINDOW_HEIGHT}]), - loop(State); - - show_window when State#state.win_created =:= true -> - gs:config(win, [raise]), - loop(State); - show_window when State#state.win_created =:= false -> - loop((init_window(State))#state{win_created = true}); - - {gs, _Id, click, close_menu, _Args} -> - gs:destroy(win), - loop(State#state{win_created = false}); - {gs, _Id, keypress, _Data, [c, _, 0, 1 | _]} -> - gs:destroy(win), - loop(State#state{win_created = false}); - {gs, _Id, keypress, _Data, ['C', _, 1, 1 | _]} -> - gs:destroy(win), - loop(State#state{win_created = false}); - {gs, _Id, keypress, _Data, _Args} -> - loop(State); - {gs, _, destroy, _, _} -> - loop(State#state{win_created = false}); - - {compilation_done, _Res, Sender} -> - case State#state.compiling of - Sender -> - catch gs:config(compmod, [{enable, true}]), - update_text(compiling, ""), - loop(update_module_box(State, - State#state.mindex, - State#state.mods, "")); - _ -> - loop(State) - end; - - {'EXIT', _Pid, _Reason} -> - exit(normal); - _Other -> - io:format("HiPE window received message ~p ~n", [_Other]), - loop(State) - after - ?POLL_INTERVAL -> - loop(update_code_listbox(State)) - end. - --spec init_window(#state{}) -> #state{}. - -init_window(State) -> - create_window(State), - gs:config(win, [{map,true}]), - update_code_listbox(State#state{win_created = true}). - --spec create_window(#state{}) -> 'ok'. - -create_window(State) -> - gs:window(win, gs:start(), [{width, ?WINDOW_WIDTH}, - {height, ?WINDOW_HEIGHT}, - {bg, ?DEFAULT_BG_COLOR}, - {title, "[HiPE] Code list"}, - {configure, true}, - {destroy, true}, - {cursor, arrow}, - {keypress, true} - ]), - create_menu(), - Xpos = 4, - Ypos1 = 60, - Width = (?WINDOW_WIDTH - (Xpos*4)) div 3, - create_labels([{mods,Ypos1-20,"Loaded Modules"}], Xpos + 1 + 3), - Xpos2 = Xpos*2+Width, - create_labels([{mod,Ypos1-20,"Module:"++atom_to_list(State#state.mod)}, - {ver,Ypos1,""}, - {time,Ypos1+20,""}, - {native,Ypos1+40,""}, - {compiling,Ypos1+60,""}], Xpos2), - create_labels([{function,Ypos1-20,"Function:"}, - {nativefun,Ypos1,""}], Xpos*3+Width*2), - Ypos = 240, - Height1 = ?WINDOW_HEIGHT - Ypos1 - Xpos, - Height = ?WINDOW_HEIGHT - Ypos - Xpos, - gs:listbox(code_listbox, win, [{x, Xpos}, - {y, Ypos1}, - {width, Width}, - {height, Height1}, - {bg, {255,255,255}}, - {vscroll, right}, - {hscroll, true}, - {click, true}]), - gs:listbox(module_listbox, win, [{x, Xpos*2+Width}, - {y, Ypos}, - {width, Width}, - {height, Height}, - {bg, {255,255,255}}, - {vscroll, right}, - {hscroll, true}, - {click, true}]), - gs:listbox(profile_listbox, win, [{x, Xpos*3+Width*2}, - {y, Ypos1+40}, - {width, Width}, - {height, Height-60}, - {bg, {255,255,255}}, - {vscroll, right}, - {hscroll, true}, - {click, true}]), - gs:button(compmod,win,[{label,{text,"Compile\nModule"}}, - {justify,center}, - {x,Xpos*2+Width*1}, - {height,60}, - {y,Ypos-80}]), - gs:button(prof,win,[{label,{text,"Profile\nModule"}}, - {justify,center}, - {x,Xpos*2+Width*1+100}, - {height,60}, - {y,Ypos-80}]), - gs:button(clearprof,win,[{label, {text,"Clear\nProfile"}}, - {justify, center}, - {x, Xpos*2+Width*1+200}, - {height, 60}, - {y, Ypos-80}]), - gs:editor(edoc,win,[{x, Xpos*3+Width*2}, {y, Ypos}, - {width, Width}, {height, Height}, - {insert, {'end',"Edit this text!"}}, - {vscroll, right}, - {hscroll, true}, - {wrap, none}]), - ok. - --spec create_menu() -> 'ok'. - -create_menu() -> - gs:menubar(menubar, win, [{bg, ?DEFAULT_BG_COLOR}]), - create_sub_menus([{mbutt, fmenu, " File", - [{" Close Ctrl-C ",close_menu}]}, - {mbuttc,cmenu, " Compile ", - [{" Compile Module", comp_mod}]}, - {mbuttp,pmenu, " Profile ", - [{" Profile Module", prof_mod}]}, - {mbutte,emenu, " Edoc", [separator]}, - {mbutta,amenu, " Analyze ", [separator]}, - {mbuttb,bmenu, " Benchmark ", [separator]}, - {mbuttj,jmenu, " Jit ", [separator]}]), - ok. - -create_menuitems(Parent, [{Text,Data}|Rest]) -> - gs:menuitem(Parent, [{bg, ?DEFAULT_BG_COLOR}, - {fg, {178, 34, 34}}, - {label, {text, Text}}, - {data, Data}, - {underline, 1} - ]), - create_menuitems(Parent, Rest); -create_menuitems(Parent, [separator|Rest]) -> - gs:menuitem(Parent, [{itemtype, separator}]), - create_menuitems(Parent, Rest); -create_menuitems(_, []) -> ok. - -create_sub_menus([{Parent, Name, Text, Items}|Rest]) -> - BG = {bg, ?DEFAULT_BG_COLOR}, - FG = {fg, {178, 34, 34}}, % firebrick - Label = {label, {text, Text}}, - gs:menubutton(Parent, menubar, [BG, FG, Label, {underline, 1}]), - gs:menu(Name, Parent, [BG, FG]), - create_menuitems(Name, Items), - create_sub_menus(Rest); -create_sub_menus([]) -> ok. - -create_labels([{Name,Y,Text}|Rest], Xpos) -> - gs:label(Name, win, [{width, (?WINDOW_WIDTH - 16) div 3}, - {height, 20}, - {x, Xpos + 1 + 3}, - {y, Y}, - {bg, ?DEFAULT_BG_COLOR}, - {fg, ?NORMAL_FG_COLOR}, - {font, ?HEADER_FONT}, - {align, w}, - {label, {text, Text}} - ]), - create_labels(Rest,Xpos); -create_labels([],_) -> ok. - --spec update_code_listbox(#state{}) -> #state{}. - -update_code_listbox(State) -> - Mods = lists:sort(mods()), - case State#state.win_created of - false -> - State; - true -> - case Mods =:= State#state.mods of - true -> State; - false -> - update_text(mods, - "Loaded Modules ("++ - integer_to_list(length(Mods))++")"), - catch gs:config(code_listbox, [{data, Mods}, - {items, Mods}, - {selection, 0}]), - update_module_box(State#state{mods = Mods}, 0, Mods, "") - end - end. - --spec update_fun(#state{}, integer(), [mfa()]) -> #state{}. - -update_fun(State, Idx, Data) -> - case State#state.win_created of - false -> - State; - true -> - MFA = {M,F,A} = get_selection(Idx, Data, {?MODULE,start,0}), - update_text(function, "Function: "++mfa_to_string(MFA)), - case in_native(F, A, native_code(M)) of - true -> update_text(nativefun, "Native"); - false -> update_text(nativefun, "Emulated") - end, - State - end. - -get_selection(Idx, Data, Default) -> - try lists:nth(Idx+1, Data) catch _:_ -> Default end. - --spec update_module_box(#state{}, integer(), [atom()], string()) -> #state{}. - -update_module_box(State, Idx, Data, _Txt) -> - case State#state.win_created of - false -> - State; - true -> - Mod = get_selection(Idx, Data, hipe_tool), - %% io:format("~w\n", [Mod:module_info()]), - Info = Mod:module_info(), - Funs = lists:usort(funs(Mod)), - MFAs = mfas(Mod, Funs), - ModText = atom_to_list(Mod), - update_text(mod, "Module:"++ModText), - update_text(compmod, "Compile\nModule\n"++ModText), - Options = get_compile(Info), - update_text(ver, get_version(Options)), - update_text(time, get_time(Options)), - NativeCode = native_code(Mod), - - Prof = is_profiled(Mod), - if Prof -> update_text(prof, "Turn off\nProfiling"); - true -> update_text(prof, "Profile\n"++ModText) - end, - - Mode = get_mode(Funs, NativeCode), - - update_text(native, Mode), - Items = fun_names(Mod, Funs, NativeCode, Prof), - - Selection = {selection, 0}, - catch gs:config(module_listbox, [{data, MFAs}, - {items, Items}, - Selection]), - ProfData = [mfa_to_string(element(1, X)) ++ " " ++ - integer_to_list(element(2,X)) - || X <- hipe_profile:res(), element(2, X) > 0], - catch gs:config(profile_listbox, [{data, ProfData}, - {items, ProfData}, - Selection]), - get_edoc(Mod), - update_fun(State#state{mindex = Idx, mod = Mod, funs = Funs}, 0, MFAs) - end. - -update_text(Lab, Text) -> - catch gs:config(Lab, [{label, {text, Text}}]). - -%%--------------------------------------------------------------------- -%% @doc Returns a list of all loaded modules. -%%--------------------------------------------------------------------- - --spec mods() -> [atom()]. - -mods() -> - [Mod || {Mod,_File} <- code:all_loaded()]. - --spec funs(module()) -> [fa()]. - -funs(Mod) -> - Mod:module_info(functions). - --spec native_code(module()) -> [fa_address()]. - -native_code(Mod) -> - Mod:module_info(native_addresses). - --spec mfas(atom(), [fa()]) -> [mfa()]. - -mfas(Mod, Funs) -> - [{Mod,F,A} || {F,A} <- Funs]. - --spec fun_names(atom(), [fa()], [fa_address()], boolean()) -> [string()]. - -fun_names(M, Funs, NativeCode, Prof) -> - [atom_to_list(F) ++ "/" ++ integer_to_list(A) - ++ - (case in_native(F, A, NativeCode) of - true -> " [native] "; - false -> "" - end) - ++ - if Prof -> - (catch integer_to_list(hipe_bifs:call_count_get({M,F,A}))); - true -> "" - end - || {F,A} <- Funs]. - --spec in_native(atom(), arity(), [fa_address()]) -> boolean(). - -in_native(F, A, NativeCode) -> - lists:any(fun({Fun,Arity,_}) -> - (Fun =:= F andalso Arity =:= A) - end, - NativeCode). - --spec mfa_to_string(mfa()) -> [char(),...]. - -mfa_to_string({M,F,A}) -> - atom_to_list(M) ++ ":" ++ atom_to_list(F) ++ "/" ++ integer_to_list(A). - -get_mode(Funs, NativeCode) -> - case NativeCode of - [] -> "Emulated"; - InNative when is_list(InNative) -> - if length(InNative) =:= length(Funs) -> - "Native"; - true -> "Mixed" - end - end. - -get_time(Comp) -> - case lists:keyfind(time, 1, Comp) of - {_, {Y,Month,D,H,Min,S}} -> - integer_to_list(Y) ++ - "-" ++ integer_to_list(Month) ++ - "-" ++ integer_to_list(D) ++ " " ++ - integer_to_list(H) ++ ":" ++ integer_to_list(Min) ++ - ":" ++ integer_to_list(S); - false -> "" - end. - -get_version(Comp) -> - case lists:keyfind(version, 1, Comp) of - {_, V} when is_list(V) -> V; - false -> "" - end. - -get_cwd(Options) -> - case lists:keyfind(cwd, 1, Options) of - {_, V} when is_atom(V) -> atom_to_list(V); - {_, V} -> V; - false -> "" - end. - -get_options(Comp) -> - case lists:keyfind(options, 1, Comp) of - {_, V} when is_list(V) -> V; - false -> "" - end. - -get_compile(Info) -> - case lists:keyfind(compile, 1, Info) of - {_, O} when is_list(O) -> O; - false -> [] - end. - --spec is_profiled(atom()) -> boolean(). - -is_profiled(Mod) -> - case hipe_bifs:call_count_get({Mod,module_info,0}) of - false -> false; - C when is_integer(C) -> true - end. - --spec compile(#state{}) -> #state{}. - -compile(State) -> - catch gs:config(compmod, [{enable, false}]), - update_text(compiling, "Compiling..."), - Parent = self(), - P = spawn(fun() -> c(Parent, State#state.mod, State#state.options) end), - State#state{compiling = P}. - --spec c(pid(), atom(), comp_options()) -> 'ok'. - -c(Parent, Mod, Options) -> - Res = hipe:c(Mod, Options), - Parent ! {compilation_done,Res,self()}, - ok. - -get_edoc(Mod) -> - Info = Mod:module_info(), - Comp = get_compile(Info), - Options = get_options(Comp), - Dir = get_cwd(Options), - File = - case Dir of - "" -> atom_to_list(Mod) ++ ".erl"; - _ -> Dir ++"/" ++ atom_to_list(Mod) ++ ".erl" - end, - %% io:format("Get ~s\n", [File]), - Text = try edoc(File, [{xml_export,xmerl_text}, no_output]) - catch _:_ -> "error" - end, - gs:config(edoc, {enable, true}), - gs:config(edoc, clear), - gs:config(edoc, {insert, {insert, Text}}), - gs:config(edoc, {enable, false}), - ok. - -edoc(Name, Opts) -> - Doc = edoc:get_doc(Name, Opts), - %% Comments = edoc:read_comments(Name, Opts), - %% Text = edoc:forms(Forms, Comments, Name, Opts), - edoc:layout(Doc, Opts), - ok. diff --git a/lib/hipe/util/Makefile b/lib/hipe/util/Makefile index a5ee232057..66e9421c25 100644 --- a/lib/hipe/util/Makefile +++ b/lib/hipe/util/Makefile @@ -1,18 +1,19 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2001-2012. All Rights Reserved. +# Copyright Ericsson AB 2001-2016. All Rights Reserved. # -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at # -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. # # %CopyrightEnd% # @@ -68,7 +69,7 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += +warn_exported_vars +warn_missing_spec +warn_untyped_record +ERL_COMPILE_FLAGS += -Werror +warn_export_vars +warn_missing_spec +warn_untyped_record # ---------------------------------------------------- # Targets diff --git a/lib/hipe/util/hipe_digraph.erl b/lib/hipe/util/hipe_digraph.erl index fcfaa64684..7446836926 100644 --- a/lib/hipe/util/hipe_digraph.erl +++ b/lib/hipe/util/hipe_digraph.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2010. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -36,10 +37,10 @@ -type ordset(T) :: [T]. % XXX: temporarily --record(hipe_digraph, {edges = dict:new() :: dict(), - rev_edges = dict:new() :: dict(), +-record(hipe_digraph, {edges = dict:new() :: dict:dict(), + rev_edges = dict:new() :: dict:dict(), leaves = ordsets:new() :: ordset(_), % ??? - nodes = sets:new() :: set()}). + nodes = sets:new() :: sets:set()}). -opaque hdg() :: #hipe_digraph{}. diff --git a/lib/hipe/util/hipe_dot.erl b/lib/hipe/util/hipe_dot.erl index e4a47ae0c4..53e474db42 100644 --- a/lib/hipe/util/hipe_dot.erl +++ b/lib/hipe/util/hipe_dot.erl @@ -2,18 +2,19 @@ %%% %%% %CopyrightBegin% %%% -%%% Copyright Ericsson AB 2004-2011. All Rights Reserved. +%%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %%% -%%% The contents of this file are subject to the Erlang Public License, -%%% Version 1.1, (the "License"); you may not use this file except in -%%% compliance with the License. You should have received a copy of the -%%% Erlang Public License along with this software. If not, it can be -%%% retrieved online at http://www.erlang.org/. -%%% -%%% Software distributed under the License is distributed on an "AS IS" -%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%%% the License for the specific language governing rights and limitations -%%% under the License. +%%% Licensed under the Apache License, Version 2.0 (the "License"); +%%% you may not use this file except in compliance with the License. +%%% You may obtain a copy of the License at +%%% +%%% http://www.apache.org/licenses/LICENSE-2.0 +%%% +%%% Unless required by applicable law or agreed to in writing, software +%%% distributed under the License is distributed on an "AS IS" BASIS, +%%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%%% See the License for the specific language governing permissions and +%%% limitations under the License. %%% %%% %CopyrightEnd% %%% @@ -70,13 +71,13 @@ %% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% --spec translate_digraph(digraph(), string(), string()) -> 'ok'. +-spec translate_digraph(digraph:graph(), string(), string()) -> 'ok'. translate_digraph(G, FileName, GName) -> translate_digraph(G, FileName, GName, fun(X) -> io_lib:format("~p", [X]) end, []). --spec translate_digraph(digraph(), string(), string(), +-spec translate_digraph(digraph:graph(), string(), string(), fun((_) -> string()), [_]) -> 'ok'. translate_digraph(G, FileName, GName, Fun, Opts) -> diff --git a/lib/hipe/util/hipe_timing.erl b/lib/hipe/util/hipe_timing.erl index 191db497e2..bf8a08dee5 100644 --- a/lib/hipe/util/hipe_timing.erl +++ b/lib/hipe/util/hipe_timing.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/util/hipe_vectors.erl b/lib/hipe/util/hipe_vectors.erl index d153f3a50d..7f6c8e91c2 100644 --- a/lib/hipe/util/hipe_vectors.erl +++ b/lib/hipe/util/hipe_vectors.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/util/hipe_vectors.hrl b/lib/hipe/util/hipe_vectors.hrl index 043faf4c91..d4556e9dc4 100644 --- a/lib/hipe/util/hipe_vectors.hrl +++ b/lib/hipe/util/hipe_vectors.hrl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2009. All Rights Reserved. +%% Copyright Ericsson AB 2008-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% @@ -24,5 +25,5 @@ -endif. -ifdef(USE_GBTREES). --type hipe_vector() :: gb_tree(). +-type hipe_vector() :: gb_trees:tree(). -endif. diff --git a/lib/hipe/vsn.mk b/lib/hipe/vsn.mk index deb16b02fd..e61c1a042c 100644 --- a/lib/hipe/vsn.mk +++ b/lib/hipe/vsn.mk @@ -1 +1 @@ -HIPE_VSN = 3.10.2 +HIPE_VSN = 3.15.1 diff --git a/lib/hipe/x86/Makefile b/lib/hipe/x86/Makefile index 3602949944..93f8b955dd 100644 --- a/lib/hipe/x86/Makefile +++ b/lib/hipe/x86/Makefile @@ -1,18 +1,19 @@ # # %CopyrightBegin% # -# Copyright Ericsson AB 2001-2012. All Rights Reserved. +# Copyright Ericsson AB 2001-2016. All Rights Reserved. # -# The contents of this file are subject to the Erlang Public License, -# Version 1.1, (the "License"); you may not use this file except in -# compliance with the License. You should have received a copy of the -# Erlang Public License along with this software. If not, it can be -# retrieved online at http://www.erlang.org/. +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at # -# Software distributed under the License is distributed on an "AS IS" -# basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -# the License for the specific language governing rights and limitations -# under the License. +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. # # %CopyrightEnd% # @@ -83,7 +84,7 @@ DOC_FILES= $(MODULES:%=$(DOCS)/%.html) include ../native.mk -ERL_COMPILE_FLAGS += +warn_exported_vars +ERL_COMPILE_FLAGS += -Werror +warn_export_vars # ---------------------------------------------------- # Targets diff --git a/lib/hipe/x86/hipe_rtl_to_x86.erl b/lib/hipe/x86/hipe_rtl_to_x86.erl index d77e4fed3b..d13f63b1d9 100644 --- a/lib/hipe/x86/hipe_rtl_to_x86.erl +++ b/lib/hipe/x86/hipe_rtl_to_x86.erl @@ -2,18 +2,19 @@ %%% %%% %CopyrightBegin% %%% -%%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %%% -%%% The contents of this file are subject to the Erlang Public License, -%%% Version 1.1, (the "License"); you may not use this file except in -%%% compliance with the License. You should have received a copy of the -%%% Erlang Public License along with this software. If not, it can be -%%% retrieved online at http://www.erlang.org/. -%%% -%%% Software distributed under the License is distributed on an "AS IS" -%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%%% the License for the specific language governing rights and limitations -%%% under the License. +%%% Licensed under the Apache License, Version 2.0 (the "License"); +%%% you may not use this file except in compliance with the License. +%%% You may obtain a copy of the License at +%%% +%%% http://www.apache.org/licenses/LICENSE-2.0 +%%% +%%% Unless required by applicable law or agreed to in writing, software +%%% distributed under the License is distributed on an "AS IS" BASIS, +%%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%%% See the License for the specific language governing permissions and +%%% limitations under the License. %%% %%% %CopyrightEnd% %%% @@ -236,7 +237,7 @@ conv_insn(I, Map, Data) -> #fconv{} -> {Dst, Map0} = conv_dst(hipe_rtl:fconv_dst(I), Map), {[], Src, Map1} = conv_src(hipe_rtl:fconv_src(I), Map0), - I2 = [hipe_x86:mk_fmove(Src, Dst)], + I2 = conv_fconv(Dst, Src), {I2, Map1, Data}; X -> %% gctest?? @@ -712,6 +713,19 @@ vmap_lookup(Map, Key) -> vmap_bind(Map, Key, Val) -> gb_trees:insert(Key, Val, Map). +%%% Finalise the conversion of an Integer-to-Float operation. + +conv_fconv(Dst, Src) -> + case hipe_x86:is_imm(Src) of + false -> + [hipe_x86:mk_fmove(Src, Dst)]; + true -> + %% cvtsi2sd does not allow src to be an immediate + Tmp = new_untagged_temp(), + [hipe_x86:mk_move(Src, Tmp), + hipe_x86:mk_fmove(Tmp, Dst)] + end. + %%% Finalise the conversion of a 2-address FP operation. conv_fp_unary(Dst, Src, FpUnOp) -> diff --git a/lib/hipe/x86/hipe_x86.erl b/lib/hipe/x86/hipe_x86.erl index 3298151366..33d7f77cf1 100644 --- a/lib/hipe/x86/hipe_x86.erl +++ b/lib/hipe/x86/hipe_x86.erl @@ -1,18 +1,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/x86/hipe_x86.hrl b/lib/hipe/x86/hipe_x86.hrl index 3d22fb381f..ef99bf90d9 100644 --- a/lib/hipe/x86/hipe_x86.hrl +++ b/lib/hipe/x86/hipe_x86.hrl @@ -1,18 +1,19 @@ %%% %%% %CopyrightBegin% %%% -%%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %%% -%%% The contents of this file are subject to the Erlang Public License, -%%% Version 1.1, (the "License"); you may not use this file except in -%%% compliance with the License. You should have received a copy of the -%%% Erlang Public License along with this software. If not, it can be -%%% retrieved online at http://www.erlang.org/. -%%% -%%% Software distributed under the License is distributed on an "AS IS" -%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%%% the License for the specific language governing rights and limitations -%%% under the License. +%%% Licensed under the Apache License, Version 2.0 (the "License"); +%%% you may not use this file except in compliance with the License. +%%% You may obtain a copy of the License at +%%% +%%% http://www.apache.org/licenses/LICENSE-2.0 +%%% +%%% Unless required by applicable law or agreed to in writing, software +%%% distributed under the License is distributed on an "AS IS" BASIS, +%%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%%% See the License for the specific language governing permissions and +%%% limitations under the License. %%% %%% %CopyrightEnd% %%% diff --git a/lib/hipe/x86/hipe_x86_assemble.erl b/lib/hipe/x86/hipe_x86_assemble.erl index 7878c7219d..e21223a5b1 100644 --- a/lib/hipe/x86/hipe_x86_assemble.erl +++ b/lib/hipe/x86/hipe_x86_assemble.erl @@ -2,18 +2,19 @@ %%% %%% %CopyrightBegin% %%% -%%% Copyright Ericsson AB 2001-2012. All Rights Reserved. +%%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %%% -%%% The contents of this file are subject to the Erlang Public License, -%%% Version 1.1, (the "License"); you may not use this file except in -%%% compliance with the License. You should have received a copy of the -%%% Erlang Public License along with this software. If not, it can be -%%% retrieved online at http://www.erlang.org/. -%%% -%%% Software distributed under the License is distributed on an "AS IS" -%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%%% the License for the specific language governing rights and limitations -%%% under the License. +%%% Licensed under the Apache License, Version 2.0 (the "License"); +%%% you may not use this file except in compliance with the License. +%%% You may obtain a copy of the License at +%%% +%%% http://www.apache.org/licenses/LICENSE-2.0 +%%% +%%% Unless required by applicable law or agreed to in writing, software +%%% distributed under the License is distributed on an "AS IS" BASIS, +%%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%%% See the License for the specific language governing permissions and +%%% limitations under the License. %%% %%% %CopyrightEnd% %%% @@ -21,7 +22,6 @@ %%% %%% TODO: %%% - Simplify combine_label_maps and mk_data_relocs. -%%% - Move find_const to hipe_pack_constants? -ifdef(HIPE_AMD64). -define(HIPE_X86_ASSEMBLE, hipe_amd64_assemble). @@ -80,10 +80,10 @@ assemble(CompiledCode, Closures, Exports, Options) -> %% ?debug_msg("Constants are ~w bytes\n",[ConstSize])), %% SC = hipe_pack_constants:slim_constmap(ConstMap), - DataRelocs = mk_data_relocs(RefsFromConsts, LabelMap), - SSE = slim_sorted_exportmap(ExportMap,Closures,Exports), + DataRelocs = hipe_pack_constants:mk_data_relocs(RefsFromConsts, LabelMap), + SSE = hipe_pack_constants:slim_sorted_exportmap(ExportMap,Closures,Exports), SlimRefs = hipe_pack_constants:slim_refs(AccRefs), - Bin = term_to_binary([{?VERSION_STRING(),?HIPE_SYSTEM_CRC}, + Bin = term_to_binary([{?VERSION_STRING(),?HIPE_ERTS_CHECKSUM}, ConstAlign, ConstSize, SC, DataRelocs, % nee LM, LabelMap @@ -442,7 +442,7 @@ translate_imm(#x86_imm{value=Imm}, Context, MayTrunc8) -> case Imm of {Label,constant} -> {MFA,ConstMap} = Context, - ConstNo = find_const({MFA,Label}, ConstMap), + ConstNo = hipe_pack_constants:find_const({MFA,Label}, ConstMap), {constant,ConstNo}; {Label,closure} -> {closure,Label}; @@ -712,7 +712,7 @@ resolve_jmp_switch_arg(I, _Context) -> {rm64,hipe_amd64_encode:rm_mem(EA)}. -else. resolve_jmp_switch_arg(I, {MFA,ConstMap}) -> - ConstNo = find_const({MFA,hipe_x86:jmp_switch_jtab(I)}, ConstMap), + ConstNo = hipe_pack_constants:find_const({MFA,hipe_x86:jmp_switch_jtab(I)}, ConstMap), Disp32 = {?LOAD_ADDRESS,{constant,ConstNo}}, SINDEX = ?HIPE_X86_ENCODE:sindex(2, hipe_x86:temp_reg(hipe_x86:jmp_switch_temp(I))), EA = ?HIPE_X86_ENCODE:ea_disp32_sindex(Disp32, SINDEX), % this creates a SIB implicitly @@ -932,37 +932,6 @@ resolve_x87_binop_args(Src=#x86_fpreg{}, Dst=#x86_fpreg{})-> %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -mk_data_relocs(RefsFromConsts, LabelMap) -> - lists:flatten(mk_data_relocs(RefsFromConsts, LabelMap, [])). - -mk_data_relocs([{MFA,Labels} | Rest], LabelMap, Acc) -> - Map = [case Label of - {L,Pos} -> - Offset = find({MFA,L}, LabelMap), - {Pos,Offset}; - {sorted,Base,OrderedLabels} -> - {sorted, Base, [begin - Offset = find({MFA,L}, LabelMap), - {Order, Offset} - end - || {L,Order} <- OrderedLabels]} - end - || Label <- Labels], - %% msg("Map: ~w Map\n",[Map]), - mk_data_relocs(Rest, LabelMap, [Map,Acc]); -mk_data_relocs([],_,Acc) -> Acc. - -find({MFA,L},LabelMap) -> - gb_trees:get({MFA,L}, LabelMap). - -slim_sorted_exportmap([{Addr,M,F,A}|Rest], Closures, Exports) -> - IsClosure = lists:member({M,F,A}, Closures), - IsExported = is_exported(F, A, Exports), - [Addr,M,F,A,IsClosure,IsExported | slim_sorted_exportmap(Rest, Closures, Exports)]; -slim_sorted_exportmap([],_,_) -> []. - -is_exported(F, A, Exports) -> lists:member({F,A}, Exports). - %%% %%% Assembly listing support (pp_asm option). %%% @@ -1001,14 +970,3 @@ fill_spaces(N) when N > 0 -> fill_spaces(N-1); fill_spaces(0) -> []. - -%%% -%%% Lookup a constant in a ConstMap. -%%% - -find_const({MFA,Label},[{pcm_entry,MFA,Label,ConstNo,_,_,_}|_]) -> - ConstNo; -find_const(N,[_|R]) -> - find_const(N,R); -find_const(C,[]) -> - ?EXIT({constant_not_found,C}). diff --git a/lib/hipe/x86/hipe_x86_cfg.erl b/lib/hipe/x86/hipe_x86_cfg.erl index d15dcc061a..ab40b68580 100644 --- a/lib/hipe/x86/hipe_x86_cfg.erl +++ b/lib/hipe/x86/hipe_x86_cfg.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/x86/hipe_x86_defuse.erl b/lib/hipe/x86/hipe_x86_defuse.erl index 3387f77595..9cba6cbe4b 100644 --- a/lib/hipe/x86/hipe_x86_defuse.erl +++ b/lib/hipe/x86/hipe_x86_defuse.erl @@ -2,18 +2,19 @@ %%% %%% %CopyrightBegin% %%% -%%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %%% -%%% The contents of this file are subject to the Erlang Public License, -%%% Version 1.1, (the "License"); you may not use this file except in -%%% compliance with the License. You should have received a copy of the -%%% Erlang Public License along with this software. If not, it can be -%%% retrieved online at http://www.erlang.org/. -%%% -%%% Software distributed under the License is distributed on an "AS IS" -%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%%% the License for the specific language governing rights and limitations -%%% under the License. +%%% Licensed under the Apache License, Version 2.0 (the "License"); +%%% you may not use this file except in compliance with the License. +%%% You may obtain a copy of the License at +%%% +%%% http://www.apache.org/licenses/LICENSE-2.0 +%%% +%%% Unless required by applicable law or agreed to in writing, software +%%% distributed under the License is distributed on an "AS IS" BASIS, +%%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%%% See the License for the specific language governing permissions and +%%% limitations under the License. %%% %%% %CopyrightEnd% %%% diff --git a/lib/hipe/x86/hipe_x86_encode.erl b/lib/hipe/x86/hipe_x86_encode.erl index db7f53ad26..3b7be86608 100644 --- a/lib/hipe/x86/hipe_x86_encode.erl +++ b/lib/hipe/x86/hipe_x86_encode.erl @@ -1,18 +1,19 @@ %%% %%% %CopyrightBegin% %%% -%%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %%% -%%% The contents of this file are subject to the Erlang Public License, -%%% Version 1.1, (the "License"); you may not use this file except in -%%% compliance with the License. You should have received a copy of the -%%% Erlang Public License along with this software. If not, it can be -%%% retrieved online at http://www.erlang.org/. -%%% -%%% Software distributed under the License is distributed on an "AS IS" -%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%%% the License for the specific language governing rights and limitations -%%% under the License. +%%% Licensed under the Apache License, Version 2.0 (the "License"); +%%% you may not use this file except in compliance with the License. +%%% You may obtain a copy of the License at +%%% +%%% http://www.apache.org/licenses/LICENSE-2.0 +%%% +%%% Unless required by applicable law or agreed to in writing, software +%%% distributed under the License is distributed on an "AS IS" BASIS, +%%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%%% See the License for the specific language governing permissions and +%%% limitations under the License. %%% %%% %CopyrightEnd% %%% diff --git a/lib/hipe/x86/hipe_x86_frame.erl b/lib/hipe/x86/hipe_x86_frame.erl index 0a3317a369..8851ead250 100644 --- a/lib/hipe/x86/hipe_x86_frame.erl +++ b/lib/hipe/x86/hipe_x86_frame.erl @@ -2,18 +2,19 @@ %%% %%% %CopyrightBegin% %%% -%%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %%% -%%% The contents of this file are subject to the Erlang Public License, -%%% Version 1.1, (the "License"); you may not use this file except in -%%% compliance with the License. You should have received a copy of the -%%% Erlang Public License along with this software. If not, it can be -%%% retrieved online at http://www.erlang.org/. -%%% -%%% Software distributed under the License is distributed on an "AS IS" -%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%%% the License for the specific language governing rights and limitations -%%% under the License. +%%% Licensed under the Apache License, Version 2.0 (the "License"); +%%% you may not use this file except in compliance with the License. +%%% You may obtain a copy of the License at +%%% +%%% http://www.apache.org/licenses/LICENSE-2.0 +%%% +%%% Unless required by applicable law or agreed to in writing, software +%%% distributed under the License is distributed on an "AS IS" BASIS, +%%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%%% See the License for the specific language governing permissions and +%%% limitations under the License. %%% %%% %CopyrightEnd% %%% diff --git a/lib/hipe/x86/hipe_x86_liveness.erl b/lib/hipe/x86/hipe_x86_liveness.erl index 6874b05a59..ce46ec920e 100644 --- a/lib/hipe/x86/hipe_x86_liveness.erl +++ b/lib/hipe/x86/hipe_x86_liveness.erl @@ -2,18 +2,19 @@ %%% %%% %CopyrightBegin% %%% -%%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %%% -%%% The contents of this file are subject to the Erlang Public License, -%%% Version 1.1, (the "License"); you may not use this file except in -%%% compliance with the License. You should have received a copy of the -%%% Erlang Public License along with this software. If not, it can be -%%% retrieved online at http://www.erlang.org/. -%%% -%%% Software distributed under the License is distributed on an "AS IS" -%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%%% the License for the specific language governing rights and limitations -%%% under the License. +%%% Licensed under the Apache License, Version 2.0 (the "License"); +%%% you may not use this file except in compliance with the License. +%%% You may obtain a copy of the License at +%%% +%%% http://www.apache.org/licenses/LICENSE-2.0 +%%% +%%% Unless required by applicable law or agreed to in writing, software +%%% distributed under the License is distributed on an "AS IS" BASIS, +%%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%%% See the License for the specific language governing permissions and +%%% limitations under the License. %%% %%% %CopyrightEnd% %%% diff --git a/lib/hipe/x86/hipe_x86_main.erl b/lib/hipe/x86/hipe_x86_main.erl index f45a49ca0a..13b0bb6b28 100644 --- a/lib/hipe/x86/hipe_x86_main.erl +++ b/lib/hipe/x86/hipe_x86_main.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/x86/hipe_x86_postpass.erl b/lib/hipe/x86/hipe_x86_postpass.erl index c0918c4f89..939baeccec 100644 --- a/lib/hipe/x86/hipe_x86_postpass.erl +++ b/lib/hipe/x86/hipe_x86_postpass.erl @@ -1,19 +1,20 @@ -%%% -*- coding: utf-8; erlang-indent-level: 2 -*- +%%% -*- erlang-indent-level: 2 -*- %%% %%% %CopyrightBegin% %%% -%%% Copyright Ericsson AB 2003-2012. All Rights Reserved. +%%% Copyright Ericsson AB 2003-2016. All Rights Reserved. %%% -%%% The contents of this file are subject to the Erlang Public License, -%%% Version 1.1, (the "License"); you may not use this file except in -%%% compliance with the License. You should have received a copy of the -%%% Erlang Public License along with this software. If not, it can be -%%% retrieved online at http://www.erlang.org/. -%%% -%%% Software distributed under the License is distributed on an "AS IS" -%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%%% the License for the specific language governing rights and limitations -%%% under the License. +%%% Licensed under the Apache License, Version 2.0 (the "License"); +%%% you may not use this file except in compliance with the License. +%%% You may obtain a copy of the License at +%%% +%%% http://www.apache.org/licenses/LICENSE-2.0 +%%% +%%% Unless required by applicable law or agreed to in writing, software +%%% distributed under the License is distributed on an "AS IS" BASIS, +%%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%%% See the License for the specific language governing permissions and +%%% limitations under the License. %%% %%% %CopyrightEnd% %%% diff --git a/lib/hipe/x86/hipe_x86_pp.erl b/lib/hipe/x86/hipe_x86_pp.erl index 555e21a446..9352cf5dbf 100644 --- a/lib/hipe/x86/hipe_x86_pp.erl +++ b/lib/hipe/x86/hipe_x86_pp.erl @@ -2,18 +2,19 @@ %%% %%% %CopyrightBegin% %%% -%%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %%% -%%% The contents of this file are subject to the Erlang Public License, -%%% Version 1.1, (the "License"); you may not use this file except in -%%% compliance with the License. You should have received a copy of the -%%% Erlang Public License along with this software. If not, it can be -%%% retrieved online at http://www.erlang.org/. -%%% -%%% Software distributed under the License is distributed on an "AS IS" -%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%%% the License for the specific language governing rights and limitations -%%% under the License. +%%% Licensed under the Apache License, Version 2.0 (the "License"); +%%% you may not use this file except in compliance with the License. +%%% You may obtain a copy of the License at +%%% +%%% http://www.apache.org/licenses/LICENSE-2.0 +%%% +%%% Unless required by applicable law or agreed to in writing, software +%%% distributed under the License is distributed on an "AS IS" BASIS, +%%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%%% See the License for the specific language governing permissions and +%%% limitations under the License. %%% %%% %CopyrightEnd% %%% diff --git a/lib/hipe/x86/hipe_x86_ra.erl b/lib/hipe/x86/hipe_x86_ra.erl index d50b9aabad..f66961a7a7 100644 --- a/lib/hipe/x86/hipe_x86_ra.erl +++ b/lib/hipe/x86/hipe_x86_ra.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/x86/hipe_x86_ra_finalise.erl b/lib/hipe/x86/hipe_x86_ra_finalise.erl index 10b4df05d2..5dd75cb7ae 100644 --- a/lib/hipe/x86/hipe_x86_ra_finalise.erl +++ b/lib/hipe/x86/hipe_x86_ra_finalise.erl @@ -2,18 +2,19 @@ %%% %%% %CopyrightBegin% %%% -%%% Copyright Ericsson AB 2004-2009. All Rights Reserved. +%%% Copyright Ericsson AB 2004-2016. All Rights Reserved. %%% -%%% The contents of this file are subject to the Erlang Public License, -%%% Version 1.1, (the "License"); you may not use this file except in -%%% compliance with the License. You should have received a copy of the -%%% Erlang Public License along with this software. If not, it can be -%%% retrieved online at http://www.erlang.org/. -%%% -%%% Software distributed under the License is distributed on an "AS IS" -%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%%% the License for the specific language governing rights and limitations -%%% under the License. +%%% Licensed under the Apache License, Version 2.0 (the "License"); +%%% you may not use this file except in compliance with the License. +%%% You may obtain a copy of the License at +%%% +%%% http://www.apache.org/licenses/LICENSE-2.0 +%%% +%%% Unless required by applicable law or agreed to in writing, software +%%% distributed under the License is distributed on an "AS IS" BASIS, +%%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%%% See the License for the specific language governing permissions and +%%% limitations under the License. %%% %%% %CopyrightEnd% %%% diff --git a/lib/hipe/x86/hipe_x86_ra_ls.erl b/lib/hipe/x86/hipe_x86_ra_ls.erl index ab7b6708ad..3e34433111 100644 --- a/lib/hipe/x86/hipe_x86_ra_ls.erl +++ b/lib/hipe/x86/hipe_x86_ra_ls.erl @@ -2,18 +2,19 @@ %%% %%% %CopyrightBegin% %%% -%%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %%% -%%% The contents of this file are subject to the Erlang Public License, -%%% Version 1.1, (the "License"); you may not use this file except in -%%% compliance with the License. You should have received a copy of the -%%% Erlang Public License along with this software. If not, it can be -%%% retrieved online at http://www.erlang.org/. -%%% -%%% Software distributed under the License is distributed on an "AS IS" -%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%%% the License for the specific language governing rights and limitations -%%% under the License. +%%% Licensed under the Apache License, Version 2.0 (the "License"); +%%% you may not use this file except in compliance with the License. +%%% You may obtain a copy of the License at +%%% +%%% http://www.apache.org/licenses/LICENSE-2.0 +%%% +%%% Unless required by applicable law or agreed to in writing, software +%%% distributed under the License is distributed on an "AS IS" BASIS, +%%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%%% See the License for the specific language governing permissions and +%%% limitations under the License. %%% %%% %CopyrightEnd% %%% diff --git a/lib/hipe/x86/hipe_x86_ra_naive.erl b/lib/hipe/x86/hipe_x86_ra_naive.erl index e9b99cd2c5..0ef4ef0a04 100644 --- a/lib/hipe/x86/hipe_x86_ra_naive.erl +++ b/lib/hipe/x86/hipe_x86_ra_naive.erl @@ -2,18 +2,19 @@ %%% %%% %CopyrightBegin% %%% -%%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %%% -%%% The contents of this file are subject to the Erlang Public License, -%%% Version 1.1, (the "License"); you may not use this file except in -%%% compliance with the License. You should have received a copy of the -%%% Erlang Public License along with this software. If not, it can be -%%% retrieved online at http://www.erlang.org/. -%%% -%%% Software distributed under the License is distributed on an "AS IS" -%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%%% the License for the specific language governing rights and limitations -%%% under the License. +%%% Licensed under the Apache License, Version 2.0 (the "License"); +%%% you may not use this file except in compliance with the License. +%%% You may obtain a copy of the License at +%%% +%%% http://www.apache.org/licenses/LICENSE-2.0 +%%% +%%% Unless required by applicable law or agreed to in writing, software +%%% distributed under the License is distributed on an "AS IS" BASIS, +%%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%%% See the License for the specific language governing permissions and +%%% limitations under the License. %%% %%% %CopyrightEnd% %%% diff --git a/lib/hipe/x86/hipe_x86_ra_postconditions.erl b/lib/hipe/x86/hipe_x86_ra_postconditions.erl index 6d7e90df43..0a70bd1d22 100644 --- a/lib/hipe/x86/hipe_x86_ra_postconditions.erl +++ b/lib/hipe/x86/hipe_x86_ra_postconditions.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2001-2012. All Rights Reserved. +%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/x86/hipe_x86_ra_x87_ls.erl b/lib/hipe/x86/hipe_x86_ra_x87_ls.erl index 6bdb08c6fb..1ee76e5948 100644 --- a/lib/hipe/x86/hipe_x86_ra_x87_ls.erl +++ b/lib/hipe/x86/hipe_x86_ra_x87_ls.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2006-2009. All Rights Reserved. +%% Copyright Ericsson AB 2006-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/x86/hipe_x86_registers.erl b/lib/hipe/x86/hipe_x86_registers.erl index 1cfa095995..179d734501 100644 --- a/lib/hipe/x86/hipe_x86_registers.erl +++ b/lib/hipe/x86/hipe_x86_registers.erl @@ -1,18 +1,19 @@ %%% %%% %CopyrightBegin% %%% -%%% Copyright Ericsson AB 2001-2009. All Rights Reserved. +%%% Copyright Ericsson AB 2001-2016. All Rights Reserved. %%% -%%% The contents of this file are subject to the Erlang Public License, -%%% Version 1.1, (the "License"); you may not use this file except in -%%% compliance with the License. You should have received a copy of the -%%% Erlang Public License along with this software. If not, it can be -%%% retrieved online at http://www.erlang.org/. -%%% -%%% Software distributed under the License is distributed on an "AS IS" -%%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%%% the License for the specific language governing rights and limitations -%%% under the License. +%%% Licensed under the Apache License, Version 2.0 (the "License"); +%%% you may not use this file except in compliance with the License. +%%% You may obtain a copy of the License at +%%% +%%% http://www.apache.org/licenses/LICENSE-2.0 +%%% +%%% Unless required by applicable law or agreed to in writing, software +%%% distributed under the License is distributed on an "AS IS" BASIS, +%%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%%% See the License for the specific language governing permissions and +%%% limitations under the License. %%% %%% %CopyrightEnd% %%% diff --git a/lib/hipe/x86/hipe_x86_spill_restore.erl b/lib/hipe/x86/hipe_x86_spill_restore.erl index cd927669fb..f17b91f33b 100644 --- a/lib/hipe/x86/hipe_x86_spill_restore.erl +++ b/lib/hipe/x86/hipe_x86_spill_restore.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2008-2010. All Rights Reserved. +%% Copyright Ericsson AB 2008-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at %% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% diff --git a/lib/hipe/x86/hipe_x86_x87.erl b/lib/hipe/x86/hipe_x86_x87.erl index 6ef14abdbb..e874490252 100644 --- a/lib/hipe/x86/hipe_x86_x87.erl +++ b/lib/hipe/x86/hipe_x86_x87.erl @@ -2,18 +2,19 @@ %% %% %CopyrightBegin% %% -%% Copyright Ericsson AB 2005-2009. All Rights Reserved. +%% Copyright Ericsson AB 2005-2016. All Rights Reserved. %% -%% The contents of this file are subject to the Erlang Public License, -%% Version 1.1, (the "License"); you may not use this file except in -%% compliance with the License. You should have received a copy of the -%% Erlang Public License along with this software. If not, it can be -%% retrieved online at http://www.erlang.org/. -%% -%% Software distributed under the License is distributed on an "AS IS" -%% basis, WITHOUT WARRANTY OF ANY KIND, either express or implied. See -%% the License for the specific language governing rights and limitations -%% under the License. +%% Licensed under the Apache License, Version 2.0 (the "License"); +%% you may not use this file except in compliance with the License. +%% You may obtain a copy of the License at +%% +%% http://www.apache.org/licenses/LICENSE-2.0 +%% +%% Unless required by applicable law or agreed to in writing, software +%% distributed under the License is distributed on an "AS IS" BASIS, +%% WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +%% See the License for the specific language governing permissions and +%% limitations under the License. %% %% %CopyrightEnd% %% |