## link-in-dependency-order-g.pkg -- Link dagwalks.
#
#
# MOTIVATION
#
# If package A references a type/fun/value in package B
# then we say package A "depends upon" package B.
#
# This is important during compiles, when we must
# have access to type information from B in order
# to compile A, and also during linking, when we
# must remember to link in B before we link A
# into a program.
#
# We represent the detailed dependency relationships
# between a set of modules using a dependency graph.
# See
#
# src/app/makelib/depend/intra-library-dependency-graph.pkg#
# We also have less detailed dependency graphs
# accurate only to the granularity of libraries: See
#
# src/app/makelib/depend/inter-library-dependency-graph.pkg#
# We need to do two kinds of dagwalks over these graphs,
# compile dagwalks and link dagwalks.
#
# To achieve good separation of concerns, we implement
# the mechanics of doing these dagwalks separately
# from the code needing them done, and hide the
# implementation details behind an abstract api.
#
# Compile dagwalks are implemented in
#
# src/app/makelib/compile/compile-in-dependency-order-g.pkg#
# Link dagwalks are implemented here.
# Compiled by:
# src/app/makelib/makelib.sublib### "I think you didn't get a reply
### because you used the terms "correct"
### and "proper", neither of which has
### much meaning in Perl culture. :-) "
###
### -- Larry Wall
stipulate
package ad = anchor_dictionary; # anchor_dictionary is from src/app/makelib/paths/anchor-dictionary.pkg package cf = compiledfile; # compiledfile is from src/lib/compiler/execution/compiledfile/compiledfile.pkg package lg = inter_library_dependency_graph; # inter_library_dependency_graph is from src/app/makelib/depend/inter-library-dependency-graph.pkg package lt = linking_mapstack; # linking_mapstack is from src/lib/compiler/execution/linking-mapstack/linking-mapstack.pkg package ms = makelib_state; # makelib_state is from src/app/makelib/main/makelib-state.pkg package sym = symbol_map; # symbol_map is from src/app/makelib/stuff/symbol-map.pkg package tt = thawedlib_tome; # thawedlib_tome is from src/app/makelib/compilable/thawedlib-tome.pkgherein
api Link_In_Dependency_Order {
#
#
drop_thawedlib_tome_from_linker_map
:
ms::Makelib_State -> tt::Thawedlib_Tome -> Void;
drop_stale_entries_from_linker_map: Void -> Void;
#
# Check all values and drop
# those that depended on other
# dropped ones.
cleanup
:
ms::Makelib_State -> Void;
make_linking_dagwalk
:
( lg::Inter_Library_Dependency_Graph,
tt::Thawedlib_Tome -> cf::Compiledfile
)
->
{ linking_mapstack
:
ms::Makelib_State
->
Null_Or( lt::Picklehash_To_Heapchunk_Mapstack ),
exports
:
sym::Map( ms::Makelib_State -> Null_Or( lt::Picklehash_To_Heapchunk_Mapstack ) )
};
clear_state
:
Void -> Void; # Discard all persistent state
unshare # Discard persistent state for a specific freezefile
:
ad::File
->
Void;
};
end;
stipulate
package ad = anchor_dictionary; # anchor_dictionary is from src/app/makelib/paths/anchor-dictionary.pkg package cf = compiledfile; # compiledfile is from src/lib/compiler/execution/compiledfile/compiledfile.pkg package err = error_message; # error_message is from src/lib/compiler/front/basics/errormsg/error-message.pkg package fil = file__premicrothread; # file__premicrothread is from src/lib/std/src/posix/file--premicrothread.pkg package flt = frozenlib_tome; # frozenlib_tome is from src/app/makelib/freezefile/frozenlib-tome.pkg package ftm = frozenlib_tome_map; # frozenlib_tome_map is from src/app/makelib/freezefile/frozenlib-tome-map.pkg package im = int_map; # int_map is from src/app/makelib/stuff/int-map.pkg package lg = inter_library_dependency_graph; # inter_library_dependency_graph is from src/app/makelib/depend/inter-library-dependency-graph.pkg package lb = lib_base; # lib_base is from src/lib/src/lib-base.pkg package lrp = link_and_run_package; # link_and_run_package is from src/lib/compiler/execution/main/link-and-run-package.pkg package lt = linking_mapstack; # linking_mapstack is from src/lib/compiler/execution/linking-mapstack/linking-mapstack.pkg package ms = makelib_state; # makelib_state is from src/app/makelib/main/makelib-state.pkg package mz = memoize; # memoize is from src/lib/std/memoize.pkg package pp = standard_prettyprinter; # standard_prettyprinter is from src/lib/prettyprint/big/src/standard-prettyprinter.pkg package sg = intra_library_dependency_graph; # intra_library_dependency_graph is from src/app/makelib/depend/intra-library-dependency-graph.pkg package shm = sharing_mode; # sharing_mode is from src/app/makelib/stuff/sharing-mode.pkg package spm = source_path_map; # source_path_map is from src/app/makelib/paths/source-path-map.pkg package sps = source_path_set; # source_path_set is from src/app/makelib/paths/source-path-set.pkg package sym = symbol_map; # symbol_map is from src/app/makelib/stuff/symbol-map.pkg package tlt = thawedlib_tome; # thawedlib_tome is from src/app/makelib/compilable/thawedlib-tome.pkg package ttm = thawedlib_tome_map; # thawedlib_tome_map is from src/app/makelib/compilable/thawedlib-tome-map.pkg package tts = thawedlib_tome_set; # thawedlib_tome_set is from src/app/makelib/compilable/thawedlib-tome-set.pkg package xns = exceptions; # exceptions is from src/lib/std/exceptions.pkg Pp = pp::Pp;
Linking_Mapstack = lt::Picklehash_To_Heapchunk_Mapstack; # Maps picklehashes to arbitrary heapchunks.
Posmap = im::Map( Linking_Mapstack ); # Given the byte offset of a pickle in a freezefile, returns (picklehash, pickle) as a Linking_Mapstack.
herein
# GENERIC INVOCATION CONTEXT:
#
# Our generic is invoked (only) by
#
# src/app/makelib/main/makelib-g.pkg #
#
#
generic package link_in_dependency_order_g (
# ==========================
#
package thawedlib_tome__to__compiledfile__map
: Thawedlib_Tome__To__Compiledfile__Map; # Thawedlib_Tome__To__Compiledfile__Map is from src/app/makelib/compile/thawedlib-tome--to--compiledfile-contents--map-g.pkg #
seed_libraries_index__local: Ref( spm::Map(Posmap) );
)
: Link_In_Dependency_Order # Link_In_Dependency_Order is from src/app/makelib/compile/link-in-dependency-order-g.pkg {
exception LINK Exception;
package t2c = thawedlib_tome__to__compiledfile__map; # Local abbreviation.
Bfun = ms::Makelib_State -> Linking_Mapstack -> Linking_Mapstack; # Bfun = ... "binding function"?
Frozenlib_Tome_Info
=
FROZENLIB_TOME_INFO
(
Bfun,
flt::Frozenlib_Tome,
List( Frozenlib_Tome_Info )
);
frozenlib_tome_info_map__local
=
REF (ftm::empty: ftm::Map( Frozenlib_Tome_Info )); # XXX BUGGO FIXME: More mutable global state :(
Thawedlib_Tome_Info
=
( Linking_Mapstack,
List( tlt::Thawedlib_Tome )
);
thawedlib_tome_info_map__local # XXX BUGGO FIXME: More mutable global state :(
=
REF (ttm::empty: ttm::Map( Thawedlib_Tome_Info ));
#
fun drop_thawedlib_tome_from_linker_map
#
(makelib_state: ms::Makelib_State)
#
(thawedlib_tome: tlt::Thawedlib_Tome)
=
{ fun check ()
=
case (tlt::get_sharing_mode thawedlib_tome)
#
shm::SHARE TRUE
=>
tlt::error
makelib_state
thawedlib_tome
err::WARNING
(cat ["sharing for ", tlt::describe_thawedlib_tome thawedlib_tome, " may be lost"])
err::null_error_body;
_ => ();
esac;
thawedlib_tome_info_map__local
:=
ttm::drop (*thawedlib_tome_info_map__local, thawedlib_tome);
check ();
};
#
fun drop_stale_entries_from_linker_map () # Called (only) by drop_stale_entries_from_compiler_and_linker_maps() in src/app/makelib/main/makelib-g.pkg =
thawedlib_tome_info_map__local
:=
ttm::keyed_filter (tlt::is_known o #1) *thawedlib_tome_info_map__local;
#
fun cleanup makelib_state
=
{ visited = REF tts::empty;
apply
(ignore o visit o #1)
(ttm::keyvals_list *thawedlib_tome_info_map__local)
where
fun visit (tome: tlt::Thawedlib_Tome)
=
if (tts::member (*visited, tome))
#
TRUE;
else
case (ttm::get (*thawedlib_tome_info_map__local, tome))
#
THE (_, list)
=>
{ bool_list = map visit list;
bool_val
=
list::all
(\\ x = x)
bool_list;
if bool_val
#
visited := tts::add (*visited, tome);
TRUE;
else
drop_thawedlib_tome_from_linker_map makelib_state tome;
FALSE;
fi;
};
#
NULL => FALSE;
esac;
fi;
end;
};
#
fun make_linking_dagwalk' # We do not call ourself recursively.
(
library_to_dagwalk as lg::LIBRARY { catalog, libfile, ... },
#
get_compiledfile: tlt::Thawedlib_Tome -> cf::Compiledfile
)
=>
{
fun exception_error (msg, error, descr, my_exception)
=
{ fun ppb (pp:Pp)
=
{ pp.newline();
pp.lit (xns::exception_message my_exception);
pp.newline();
};
error (cat [msg, " ", descr]) ppb;
raise exception LINK my_exception;
};
#
fun link_frozenlib_tome
(
tome: flt::Frozenlib_Tome,
linking_mapstack: Linking_Mapstack
)
=
{
description = flt::describe_frozenlib_tome tome; # Something like "$ROOT/src/lib/x-kit/xkit.lib@243309(src/color/rgb.pkg)"
error = tome.plaint_sink err::ERROR;
compiledfile
=
t2c::get_compiledfile_from_freezefile
{
freezefile_name => tome.freezefile_name,
offset => tome.byte_offset_in_freezefile,
description
}
except
exn = exception_error ("Unable to load library module", error, description, exn);
cf::link_and_run_compiledfile (compiledfile, linking_mapstack, LINK)
except
LINK exn = exception_error ("link-time exception in library code", error, description, exn);
};
#
fun link_thawedlib_tome
(
makelib_state: ms::Makelib_State,
thawedlib_tome: tlt::Thawedlib_Tome,
get_compiledfile: tlt::Thawedlib_Tome -> cf::Compiledfile,
get_linking_mapstack: ms::Makelib_State -> Null_Or( lt::Picklehash_To_Heapchunk_Mapstack ),
thawedlib_tome_list: List( tlt::Thawedlib_Tome )
)
=
{ fun fresh ()
=
{ compiledfile
=
get_compiledfile thawedlib_tome;
case (get_linking_mapstack makelib_state)
#
THE linking_mapstack =>
THE (cf::link_and_run_compiledfile (compiledfile, linking_mapstack, LINK))
except
LINK exn
=
exception_error (
"link-time exception in user program",
tlt::error makelib_state thawedlib_tome err::ERROR,
tlt::describe_thawedlib_tome thawedlib_tome,
exn
);
#
NULL => NULL;
esac;
}
except
exn as LINK _ => raise exception exn;
_ => NULL;
end;
case (tlt::get_sharing_mode thawedlib_tome)
#
shm::DO_NOT_SHARE
=>
{ drop_thawedlib_tome_from_linker_map makelib_state thawedlib_tome;
fresh ();
};
shm::SHARE _
=>
case (ttm::get (*thawedlib_tome_info_map__local, thawedlib_tome))
#
THE (de, _) => THE de;
#
NULL
=>
case (fresh ())
#
THE de => THE de
where
thawedlib_tome_info_map__local
:=
ttm::set
(
*thawedlib_tome_info_map__local,
thawedlib_tome,
(de, thawedlib_tome_list)
);
end;
#
NULL => NULL;
esac;
esac;
esac;
};
visited = REF sps::empty;
note_library library_to_dagwalk
where
fun note_library (library_to_note as lg::LIBRARY lib)
=>
{ lib -> { libfile, more, sublibraries, ... };
#
fun note_sublib NULL => ();
note_sublib (THE sublibs_index) => note_library ((list::nth (sublibraries, sublibs_index)).library_thunk ());
end;
# list is from src/lib/std/src/list.pkg #
fun note_freezefile (lg::LIBRARY stable_library)
=>
{ stable_library
->
{ catalog, libfile => stable_library_path, ... };
posmap # Pickle-in-freezefile info: Maps byteoffset of pickle in freezefile to (picklehash, pickle)
=
case (spm::get_and_drop (*seed_libraries_index__local, stable_library_path))
#
(seed_libraries_index', THE posmap)
=>
{ seed_libraries_index__local := seed_libraries_index';
posmap;
};
_ => im::empty;
esac;
localmap = REF ftm::empty;
#
fun do_frozenlib_tome_tin
#
(sg::FROZENLIB_TOME_TIN tin)
:
( ms::Makelib_State -> lt::Picklehash_To_Heapchunk_Mapstack -> lt::Picklehash_To_Heapchunk_Mapstack,
Null_Or( (flt::Frozenlib_Tome, List(Frozenlib_Tome_Info)))
)
=
{ near_imports = tin.near_imports: List( sg::Frozenlib_Tome_Tin );
far_imports = tin.far_import_thunks: List( Void -> sg::Far_Frozenlib_Tome );
#
fun my_sysval ()
=
im::get (posmap, tin.frozenlib_tome.byte_offset_in_freezefile);
#
fun new ()
=
case (my_sysval ())
#
# We short-circuit tree
# construction (and the resulting
# dagwalk) whenever we find a
# node whose linking value was
# created at bootstrap time.
# This assumes that anything in
# sysval can be shared -- which
# is enforced by the way the
# LIBRARY_CONTENTS file is constructed.
#
THE e => (\\ makelib_state = \\ _ = e, NULL);
#
NULL =>
{ e0 = (\\ _ = lt::empty, []);
#
fun join ((bfun, NULL), (e, l))
=>
(\\ makelib_state
=
lt::atop (bfun makelib_state lt::empty, e makelib_state), l);
join ((bfun, THE (frozenlib_tome, l')), (e, l))
=>
(e, FROZENLIB_TOME_INFO (bfun, frozenlib_tome, l') ! l);
end;
ge = fold_forward join e0 (map do_far_frozenlib_tome_thunk far_imports);
le = fold_forward join ge (map do_frozenlib_tome_tin near_imports);
case (tin.frozenlib_tome.sharing_mode, le)
#
(shm::SHARE _, (e, []))
=>
{ fun thunk makelib_state
=
link_frozenlib_tome (tin.frozenlib_tome, e makelib_state);
memoized_thunk = mz::memoize thunk;
( \\ makelib_state = \\ _ = memoized_thunk makelib_state,
NULL
);
};
(shm::SHARE _, _)
=>
err::impossible
"Link: sharing_mode inconsistent";
(shm::DO_NOT_SHARE, (e, l))
=>
(\\ makelib_state = \\ e' =
link_frozenlib_tome
(tin.frozenlib_tome, lt::atop (e', e makelib_state)),
THE (tin.frozenlib_tome, l));
esac;
};
esac;
case (ftm::get (*frozenlib_tome_info_map__local, tin.frozenlib_tome))
#
THE (FROZENLIB_TOME_INFO (bfun, frozenlib_tome, []))
=>
case frozenlib_tome.sharing_mode
#
shm::DO_NOT_SHARE
=>
(bfun, THE (frozenlib_tome, []));
_ =>
(bfun, NULL);
esac;
THE (FROZENLIB_TOME_INFO (bfun, frozenlib_tome, l))
=>
(bfun, THE (frozenlib_tome, l));
NULL=>
case (ftm::get (*localmap, tin.frozenlib_tome))
#
THE x => x;
#
NULL => x
where
x = new ();
#
localmap
:=
ftm::set
(*localmap, tin.frozenlib_tome, x);
end;
esac;
esac;
} # fun do_frozenlib_tome_tin
also
fun do_far_frozenlib_tome (tome: sg::Far_Frozenlib_Tome)
=
{ note_sublib tome.sublibs_index;
do_frozenlib_tome_tin tome.frozenlib_tome_tin;
}
also
fun do_far_frozenlib_tome_thunk far_frozenlib_tome_thunk
=
do_far_frozenlib_tome (far_frozenlib_tome_thunk ());
#
fun do_tome (sg::TOME_IN_FROZENLIB { frozenlib_tome_tin => frozenlib_tome_tin as sg::FROZENLIB_TOME_TIN tin, sublibs_index, ... }): Void
=>
{ note_sublib sublibs_index;
my frozenlib_tome_info as FROZENLIB_TOME_INFO (_, frozenlib_tome', _)
=
case (do_frozenlib_tome_tin frozenlib_tome_tin)
#
(bfun, NULL) => FROZENLIB_TOME_INFO (bfun, tin.frozenlib_tome, []);
(bfun, THE (frozenlib_tome'', l)) => FROZENLIB_TOME_INFO (bfun, frozenlib_tome'', l);
esac;
frozenlib_tome_info_map__local
:=
ftm::set
(*frozenlib_tome_info_map__local, frozenlib_tome', frozenlib_tome_info);
};
do_tome (sg::TOME_IN_THAWEDLIB n)
=>
err::impossible "Link: THAWEDLIB_TOME in frozen library"; # One prime invariant is that we never allow frozen libraries to refer to thawed libraries.
end;
#
fun do_far_tome
{ exports_mask: sg::Exports_Mask,
tome_tin: sg::Tome_Tin
}
: Void
=
do_tome tome_tin;
#
fun import_export (t: lg::Fat_Tome)
=
do_far_tome (t.masked_tome_thunk ());
sym::apply import_export catalog;
};
note_freezefile lg::BAD_LIBRARY
=>
();
end; # fun note_freezefile
#
fun force thunk = thunk ();
if (not (sps::member (*visited, libfile)))
#
visited := sps::add (*visited, libfile);
case more
#
lg::MAIN_LIBRARY { frozen_vs_thawed_stuff => lg::FROZENLIB_STUFF _, ... }
=>
note_freezefile library_to_note;
#
_ =>
apply
(note_library o force o .library_thunk)
sublibraries;
esac;
fi;
};
note_library lg::BAD_LIBRARY
=>
();
end; # fun note_library
end;
l_stablemap = REF ftm::empty;
l_smlmap = REF ttm::empty;
#
fun bin_node (FROZENLIB_TOME_INFO (f, i, l))
=
case (ftm::get (*l_stablemap, i))
#
THE th => th;
#
NULL =>
memoized_thunk
where
fl = map bin_node l;
#
fun th makelib_state
=
{ fun add (t, e)
=
lt::atop (t makelib_state, e);
f makelib_state (fold_forward add lt::empty fl);
};
memoized_thunk
=
mz::memoize th;
l_stablemap
:=
ftm::set (*l_stablemap, i, memoized_thunk);
end;
esac;
#
fun do_tome (sg::TOME_IN_FROZENLIB { frozenlib_tome_tin => sg::FROZENLIB_TOME_TIN { frozenlib_tome, ... }, ... })
=>
{ b = the (ftm::get (*frozenlib_tome_info_map__local, frozenlib_tome));
#
fun th makelib_state
=
THE (bin_node b makelib_state)
except
exn as LINK _ => raise exception exn;
_ => NULL;
end ;
(th, []);
};
do_tome (sg::TOME_IN_THAWEDLIB tome)
=>
sourcefile_node tome;
end
also
fun sourcefile_node (sg::THAWEDLIB_TOME_TIN tin)
=
{ tin -> { thawedlib_tome: tlt::Thawedlib_Tome,
near_imports: List( sg::Thawedlib_Tome_Tin ),
far_imports: List( sg::Masked_Tome )
};
case (ttm::get (*l_smlmap, thawedlib_tome))
#
THE thunk
=>
(thunk, [thawedlib_tome]);
NULL
=>
{ fun atop (THE e, THE e') => THE (lt::atop (e, e'));
atop _ => NULL;
end;
#
fun add ( (f, l ),
(f', l')
)
=
( \\ makelib_state
=
atop
( f makelib_state,
f' makelib_state
),
l @ l'
);
far_imports
=
fold_forward
add
(\\ _ = THE lt::empty, [])
(map
do_far_tome
far_imports
);
my ( get_linking_mapstack: ms::Makelib_State -> Null_Or( lt::Picklehash_To_Heapchunk_Mapstack ),
thawedlib_tome_list: List( tlt::Thawedlib_Tome )
)
=
fold_forward
add
far_imports
(map sourcefile_node near_imports);
#
fun thunk makelib_state
=
link_thawedlib_tome
( makelib_state,
thawedlib_tome,
get_compiledfile,
get_linking_mapstack,
thawedlib_tome_list
);
memoized_thunk
=
mz::memoize thunk;
# memoize is from src/lib/std/memoize.pkg l_smlmap
:=
ttm::set
(*l_smlmap, thawedlib_tome, memoized_thunk);
(memoized_thunk, [thawedlib_tome]);
};
esac;
}
also
fun do_far_tome { exports_mask, tome_tin }
=
do_tome tome_tin;
#
fun import_export (t: lg::Fat_Tome) makelib_state
=
#1 (do_far_tome (t.masked_tome_thunk ())) makelib_state
except
LINK exn = raise exception lrp::LINK;
exports = sym::map import_export catalog;
#
fun linking_mapstack makelib_state
=
{ fun one (_, NULL ) => NULL;
#
one (f, THE e) => case (f makelib_state)
#
NULL => NULL;
THE e' => THE (lt::atop (e', e));
esac;
end;
sym::fold_forward
one
(THE lt::empty)
exports;
};
{ exports, linking_mapstack };
};
make_linking_dagwalk' (lg::BAD_LIBRARY, _)
=>
{ linking_mapstack => \\ _ = NULL,
exports => sym::empty
};
end; # fun make_linking_dagwalk'
# This is our main entrypoint, invoked twice in
#
# src/app/makelib/main/makelib-g.pkg #
fun make_linking_dagwalk (x as (lg::LIBRARY { catalog, ... }, get_compiledfile))
#####################
=>
{
dagwalk_thunk
=
mz::memoize
{. make_linking_dagwalk' x; };
{ linking_mapstack
=>
\\ makelib_state = (dagwalk_thunk ()).linking_mapstack makelib_state,
exports
=>
sym::keyed_map
#
(\\ (symbol, _)
=
\\ makelib_state
=
the (sym::get
( (dagwalk_thunk()).exports,
symbol
)
)
makelib_state
)
#
catalog
};
};
make_linking_dagwalk (x as (lg::BAD_LIBRARY, _))
=>
make_linking_dagwalk' x;
end;
#
fun clear_state ()
=
{ frozenlib_tome_info_map__local := ftm::empty;
thawedlib_tome_info_map__local := ttm::empty;
};
#
fun unshare libfile
=
{
frozenlib_tome_info_map__local
:=
ftm::keyed_filter
other
*frozenlib_tome_info_map__local
where
fun other (tome: flt::Frozenlib_Tome, _)
=
ad::compare (tome.libfile, libfile) != EQUAL;
end;
seed_libraries_index__local
:=
spm::drop (*seed_libraries_index__local, libfile);
};
};
end;
## (C) 1999 Lucent Technologies, Bell Laboratories
## Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2015,
## released per terms of SMLNJ-COPYRIGHT.