Skip to content
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion erts/emulator/sys/unix/sys.c
Original file line number Diff line number Diff line change
Expand Up @@ -926,7 +926,7 @@ void erts_do_break_handling(void)
}


/* Fills in the systems representation of the jam/beam process identifier.
/* Fills in the systems representation of the Beam process identifier.
** The Pid is put in STRING representation in the supplied buffer,
** no interpretatione of this should be done by the rest of the
** emulator. The buffer should be at least 21 bytes long.
Expand Down
1 change: 0 additions & 1 deletion erts/emulator/test/statistics_SUITE.erl
Original file line number Diff line number Diff line change
Expand Up @@ -230,7 +230,6 @@ do_much(N) ->

%% Test that statistics(reductions) is callable, and that
%% Total_Reductions and Reductions_Since_Last_Call make sense.
%% This to fail on pre-R3A version of JAM.
reductions(Config) when is_list(Config) ->
{Reductions, _} = statistics(reductions),

Expand Down
4 changes: 2 additions & 2 deletions erts/emulator/utils/make_preload
Original file line number Diff line number Diff line change
Expand Up @@ -30,7 +30,7 @@ use File::Basename;
# standard output.
#
# Usage:
# make_preload [ Options ] file.{jam,beam}
# make_preload [ Options ] file.beam
#
# Options:
# -rc Produce a resource script rather than C source.
Expand Down Expand Up @@ -133,7 +133,7 @@ if ($gen_rc) {

sub usage {
warn "$progname: ", @_, "\n";
die "usage: $progname -o output-directory file.{jam,beam}\n";
die "usage: $progname -o output-directory file.beam\n";
}

sub error {
Expand Down
5 changes: 2 additions & 3 deletions erts/preloaded/src/init.erl
Original file line number Diff line number Diff line change
Expand Up @@ -1839,10 +1839,9 @@ reverse([A, B | L]) ->
-doc false.
-spec objfile_extension() -> nonempty_string().
objfile_extension() ->
".beam".
".beam". % currently only one possibility
%% %% if there are several implementations:
%% case erlang:system_info(machine) of
%% "JAM" -> ".jam";
%% "VEE" -> ".vee";
%% "BEAM" -> ".beam"
%% end.

Expand Down
34 changes: 21 additions & 13 deletions lib/inets/test/rules.mk
Original file line number Diff line number Diff line change
@@ -1,11 +1,26 @@
#-*-makefile-*- ; force emacs to enter makefile-mode
# ----------------------------------------------------
# Make include file for otp

# %CopyrightBegin%
#
# Copyright (C) 1996, Ericsson Telecommunications
# Author: Lars Thorsen
# ----------------------------------------------------
.SUFFIXES: .hrl .erl .jam .beam
# SPDX-License-Identifier: Apache-2.0
#
# Copyright Ericsson AB 1996-2026. 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%

.SUFFIXES: .hrl .erl .beam


# ----------------------------------------------------
Expand All @@ -22,7 +37,6 @@ ERL_COMPILE_FLAGS += +debug_info
ERLC_WFLAGS = -W
ERLC = erlc $(ERLC_WFLAGS) $(ERLC_FLAGS)
ERL.beam = erl.beam -boot start_clean
ERL.jam = erl -boot start_clean
ERL = $(ERL.$(EMULATOR))

ifeq ($(EBIN),)
Expand All @@ -32,14 +46,8 @@ endif
ESRC = .


$(EBIN)/%.jam: $(ESRC)/%.erl
$(ERLC) -bjam $(ERL_COMPILE_FLAGS) -o$(EBIN) $<

$(EBIN)/%.beam: $(ESRC)/%.erl
$(ERLC) -bbeam $(ERL_COMPILE_FLAGS) -o$(EBIN) $<

.erl.jam:
$(ERLC) -bjam $(ERL_COMPILE_FLAGS) -o$(dir $@) $<

.erl.beam:
$(ERLC) -bbeam $(ERL_COMPILE_FLAGS) -o$(dir $@) $<
9 changes: 1 addition & 8 deletions lib/megaco/src/rules.mk
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,7 @@
#
# %CopyrightEnd%

.SUFFIXES: .erl .jam .beam .yrl .hrl .sgml .html .so .c .flex .flex.src
.SUFFIXES: .erl .beam .yrl .hrl .sgml .html .so .c .flex .flex.src


CC = gcc
Expand All @@ -35,7 +35,6 @@ EMULATOR = beam
ERLC_WFLAGS = -W
ERLC = erlc $(ERLC_WFLAGS) $(ERLC_FLAGS)
ERL.beam = erl.beam -boot start_clean
ERL.jam = erl -boot start_clean
ERL = $(ERL.$(EMULATOR))

ifndef EBIN
Expand All @@ -46,15 +45,9 @@ ifndef ESRC
ESRC = .
endif

$(EBIN)/%.jam: $(ESRC)/%.erl
$(ERLC) -bjam $(ERL_COMPILE_FLAGS) -o$(EBIN) $<

$(EBIN)/%.beam: $(ESRC)/%.erl
$(ERLC) -bbeam $(ERL_COMPILE_FLAGS) -o$(EBIN) $<

.erl.jam:
$(ERLC) -bjam $(ERL_COMPILE_FLAGS) -o$(dir $@) $<

.erl.beam:
$(ERLC) -bbeam $(ERL_COMPILE_FLAGS) -o$(dir $@) $<

Expand Down
2 changes: 1 addition & 1 deletion lib/sasl/src/release_handler.erl
Original file line number Diff line number Diff line change
Expand Up @@ -302,7 +302,7 @@ release_handler does.
%% | |- start_erl (reads start_erl.data)
%% | |_ <to_erl>
%% |
%% |- erts-EVsn1 --- bin --- <jam44>
%% |- erts-EVsn1 --- bin --- <beam.smp>
%% | |- <epmd>
%% | |_ erl
%% |- erts-EVsn2
Expand Down
32 changes: 16 additions & 16 deletions lib/stdlib/src/filename.erl
Original file line number Diff line number Diff line change
Expand Up @@ -338,10 +338,10 @@ skip_prefix(Name, _) ->
%% that you know exists, but you are not sure which one it is.
%%
%% Example: basename("~/src/kalle.erl", ".erl") -> "kalle"
%% basename("~/src/kalle.jam", ".erl") -> "kalle.jam"
%% basename("~/src/kalle.beam", ".erl") -> "kalle.beam"
%% basename("~/src/kalle.old.erl", ".erl") -> "kalle.old"
%%
%% rootname(basename("xxx.jam")) -> "xxx"
%% rootname(basename("xxx.beam")) -> "xxx"
%% rootname(basename("xxx.erl")) -> "xxx"

-doc """
Expand Down Expand Up @@ -521,7 +521,7 @@ dirjoin1([H|T],Acc,Sep) ->
%% is no extension.
%%
%% Example: extension("foo.erl") -> ".erl"
%% extension("jam.src/kalle") -> ""
%% extension("bork.src/kalle") -> ""
%%
%% On Windows: fn:dirname("\\usr\\src/kalle.erl") -> "/usr/src"

Expand All @@ -534,7 +534,7 @@ _Examples:_
```erlang
15> filename:extension("foo.erl").
".erl"
16> filename:extension("beam.src/kalle").
16> filename:extension("bork.src/kalle").
[]
```
""".
Expand Down Expand Up @@ -832,19 +832,19 @@ win32_pathtype(_) -> relative.

%% Returns all characters in the filename, except the extension.
%%
%% Examples: rootname("/jam.src/kalle") -> "/jam.src/kalle"
%% rootname("/jam.src/foo.erl") -> "/jam.src/foo"
%% Examples: rootname("/bork.src/kalle") -> "/bork.src/kalle"
%% rootname("/bork.src/foo.erl") -> "/bork.src/foo"

-doc """
Removes the filename extension.

_Examples:_

```erlang
1> filename:rootname("/beam.src/kalle").
"/beam.src/kalle"
2> filename:rootname("/beam.src/foo.erl").
"/beam.src/foo"
1> filename:rootname("/bork.src/kalle").
"/bork.src/kalle"
2> filename:rootname("/bork.src/foo.erl").
"/bork.src/foo"
```
""".
-spec rootname(Filename) -> file:filename_all() when
Expand Down Expand Up @@ -874,19 +874,19 @@ rootname([], Root, _Ext, _OsType) ->
%% If the filename has another extension, the complete filename is
%% returned.
%%
%% Examples: rootname("/jam.src/kalle.jam", ".erl") -> "/jam.src/kalle.jam"
%% rootname("/jam.src/foo.erl", ".erl") -> "/jam.src/foo"
%% Examples: rootname("/bork.src/kalle.beam", ".erl") -> "/bork.src/kalle.beam"
%% rootname("/bork.src/foo.erl", ".erl") -> "/bork.src/foo"

-doc """
Removes the filename extension `Ext` from `Filename`.

_Examples:_

```erlang
1> filename:rootname("/beam.src/foo.erl", ".erl").
"/beam.src/foo"
2> filename:rootname("/beam.src/foo.beam", ".erl").
"/beam.src/foo.beam"
1> filename:rootname("/bork.src/foo.erl", ".erl").
"/bork.src/foo"
2> filename:rootname("/bork.src/foo.beam", ".erl").
"/bork.src/foo.beam"
```
""".
-spec rootname(Filename, Ext) -> file:filename_all() when
Expand Down
4 changes: 0 additions & 4 deletions lib/stdlib/test/epp_SUITE_data/mac3.erl
Original file line number Diff line number Diff line change
Expand Up @@ -30,10 +30,6 @@
-m(?MODULE).
-ms(?MODULE_STRING).

-ifdef(JAM).
-machine2(jam).
-endif.

-ifdef(BEAM).
-machine2(beam).
-endif.
38 changes: 19 additions & 19 deletions lib/stdlib/test/filename_SUITE.erl
Original file line number Diff line number Diff line change
Expand Up @@ -445,19 +445,19 @@ pathtype(Config) when is_list(Config) ->
end.

rootname(Config) when is_list(Config) ->
"/jam.src/kalle" = filename:rootname("/jam.src/kalle"),
"/jam.src/foo" = filename:rootname("/jam.src/foo.erl"),
"/jam.src/.gitignore" = filename:rootname("/jam.src/.gitignore"),
"/jam.src/.git" = filename:rootname("/jam.src/.git.ignore"),
"/jam.src/." = filename:rootname("/jam.src/..gitignore"),
"/jam.src/foo" = filename:rootname(["/ja",'m.sr',"c/foo.erl"]),
"/jam.src/foo" = filename:rootname("/jam.src/foo.erl", ".erl"),
"/jam.src/.gitignore" = filename:rootname("/jam.src/.gitignore", ".gitignore"),
"/jam.src/.git" = filename:rootname("/jam.src/.git.ignore", ".ignore"),
"/jam.src/." = filename:rootname("/jam.src/..gitignore", ".gitignore"),
"/jam.src/foo.jam" = filename:rootname("/jam.src/foo.jam", ".erl"),
"/jam.src/foo.jam" = filename:rootname(["/jam.sr",'c/foo.j',"am"],".erl"),
"/jam.src/foo.jam" = filename:rootname(["/jam.sr",'c/foo.j'|am],".erl"),
"/bork.src/kalle" = filename:rootname("/bork.src/kalle"),
"/bork.src/foo" = filename:rootname("/bork.src/foo.erl"),
"/bork.src/.gitignore" = filename:rootname("/bork.src/.gitignore"),
"/bork.src/.git" = filename:rootname("/bork.src/.git.ignore"),
"/bork.src/." = filename:rootname("/bork.src/..gitignore"),
"/bork.src/foo" = filename:rootname(["/bo",'rk.sr',"c/foo.erl"]),
"/bork.src/foo" = filename:rootname("/bork.src/foo.erl", ".erl"),
"/bork.src/.gitignore" = filename:rootname("/bork.src/.gitignore", ".gitignore"),
"/bork.src/.git" = filename:rootname("/bork.src/.git.ignore", ".ignore"),
"/bork.src/." = filename:rootname("/bork.src/..gitignore", ".gitignore"),
"/bork.src/foo.beam" = filename:rootname("/bork.src/foo.beam", ".erl"),
"/bork.src/foo.beam" = filename:rootname(["/bork.sr",'c/foo.b',"eam"],".erl"),
"/bork.src/foo.beam" = filename:rootname(["/bork.sr",'c/foo.b'|eam],".erl"),
ok.

split(Config) when is_list(Config) ->
Expand Down Expand Up @@ -824,12 +824,12 @@ pathtype_bin(Config) when is_list(Config) ->
end.

rootname_bin(Config) when is_list(Config) ->
<<"/jam.src/kalle">> = filename:rootname(<<"/jam.src/kalle">>),
<<"/jam.src/foo">> = filename:rootname(<<"/jam.src/foo.erl">>),
<<"/jam.src/foo">> = filename:rootname(<<"/jam.src/foo.erl">>, <<".erl">>),
<<"/jam.src/foo.jam">> = filename:rootname(<<"/jam.src/foo.jam">>, <<".erl">>),
<<"/jam.src/foo.jam">> = filename:rootname(["/jam.sr",'c/foo.j',"am"],<<".erl">>),
<<"/jam.src/foo.jam">> = filename:rootname(["/jam.sr",'c/foo.j'|am],<<".erl">>),
<<"/bork.src/kalle">> = filename:rootname(<<"/bork.src/kalle">>),
<<"/bork.src/foo">> = filename:rootname(<<"/bork.src/foo.erl">>),
<<"/bork.src/foo">> = filename:rootname(<<"/bork.src/foo.erl">>, <<".erl">>),
<<"/bork.src/foo.beam">> = filename:rootname(<<"/bork.src/foo.beam">>, <<".erl">>),
<<"/bork.src/foo.beam">> = filename:rootname(["/bork.sr",'c/foo.b',"eam"],<<".erl">>),
<<"/bork.src/foo.beam">> = filename:rootname(["/bork.sr",'c/foo.b'|eam],<<".erl">>),
ok.

split_bin(Config) when is_list(Config) ->
Expand Down
4 changes: 2 additions & 2 deletions lib/tools/emacs/erlang-start.el
Original file line number Diff line number Diff line change
Expand Up @@ -133,12 +133,12 @@ A function suitable for `eldoc-documentation-function'.\n\n(fn)" nil nil)
(add-to-list 'interpreter-mode-alist (cons "escript" 'erlang-mode))

;;
;; Ignore files ending in ".jam", ".vee", and ".beam" when performing
;; Ignore files ending in ".beam" when performing
;; file completion and in dired omit mode.
;;

;;;###autoload
(let ((erl-ext '(".jam" ".vee" ".beam")))
(let ((erl-ext '(".beam")))
(while erl-ext
(add-to-list 'completion-ignored-extensions (car erl-ext))
(when (boundp 'dired-omit-extensions)
Expand Down
6 changes: 3 additions & 3 deletions lib/tools/emacs/erlang_appwiz.el
Original file line number Diff line number Diff line change
Expand Up @@ -1312,15 +1312,15 @@ Please see the function `tempo-define-template'.")
appwiz-erlang-modulename appwiz-erlang-ext ".erl" n
n
(upcase appwiz-erlang-modulename) "_OBJECT_FILES = $("
(upcase appwiz-erlang-modulename) "_SOURCE_FILES:.erl=.jam)" n
(upcase appwiz-erlang-modulename) "_SOURCE_FILES:.erl=.beam)" n
n
n
(erlang-skel-makefile-separator)
"#" n
"# Transformations " n
"#" n
n
".erl.jam:" n
".erl.beam:" n
" $(ERL) $<" n
n
(erlang-skel-makefile-separator) n
Expand All @@ -1341,7 +1341,7 @@ Please see the function `tempo-define-template'.")
"$(" (upcase appwiz-erlang-modulename) "_OBJECT_FILES): $("
(upcase appwiz-erlang-modulename) "_HEADER_FILES)" n
n
".SUFFIXES : .erl .jam" n
".SUFFIXES : .erl .beam" n
n
))

Expand Down
7 changes: 2 additions & 5 deletions lib/tools/src/xref_base.erl
Original file line number Diff line number Diff line change
Expand Up @@ -668,9 +668,8 @@ do_add_application(S, XApp) ->
%% -> {ok, Modules, NewState} | throw(Error)
do_add_directory(Dir, AppName, Bui, Rec, Ver, War, State) ->
ok = is_filename(Dir),
{FileNames, Errors, Jams, Unreadable} =
xref_utils:scan_directory(Dir, Rec, [?Suffix], [".jam"]),
warnings(War, jam, Jams),
{FileNames, Errors, _Watched, Unreadable} =
xref_utils:scan_directory(Dir, Rec, [?Suffix], []),
warnings(War, unreadable, Unreadable),
case Errors of
[] ->
Expand Down Expand Up @@ -1805,8 +1804,6 @@ message(true, What, Arg) ->
io:format("~tp: 1 unresolved call~n", Arg);
unresolved_summary ->
io:format("~tp: ~tp unresolved calls~n", Arg);
jam ->
io:format("Skipping ~ts (probably JAM file)~n", [Arg]);
unreadable ->
io:format("Skipping ~ts (unreadable)~n", [Arg]);
xref_attr ->
Expand Down
2 changes: 1 addition & 1 deletion lib/tools/test/make_SUITE.erl
Original file line number Diff line number Diff line change
Expand Up @@ -167,7 +167,7 @@ emake_opts(Config) when is_list(Config) ->
ok.

%% Moves to the data directory of this suite, clean it from any object
%% files (*.jam for a JAM emulator). Returns the previous directory.
%% files. Returns the previous directory.
prepare_data_dir(Config) ->
{ok, Current} = file:get_cwd(),
{value, {data_dir, Dir}} = lists:keysearch(data_dir, 1, Config),
Expand Down
Loading