Diff of /sml/trunk/src/cm/stable/stabilize.sml

Parent Directory | Revision Log | Patch

	revision 307, Tue Jun 1 09:38:28 1999 UTC	revision 308, Wed Jun 2 01:26:19 1999 UTC
#	Line 34	Line 34
34	val compare = compare	val compare = compare
35	end)	end)
36
37	fun stabilize (g as GG.GROUP grec, binSizeOf, binCopy, gp) =	fun genStableInfoMap (exports, group) = let
38		(* find all the exported bnodes that are in the same group: *)
39		fun add (((_, DG.SB_BNODE (n as DG.BNODE b)), _), m) = let
40		val i = #bininfo b
41		in
42		if AbsPath.compare (BinInfo.group i, group) = EQUAL then
43		IntBinaryMap.insert (m, BinInfo.offset i, n)
44		else m
45		end
46		| add (_, m) = m
47		in
48		SymbolMap.foldl add IntBinaryMap.empty exports
49		end
50
51		fun stabilize gp (g as GG.GROUP grec, binSizeOf, copyBin, outs) =
52	case #stableinfo grec of	case #stableinfo grec of
53	GG.STABLE _ => g	GG.STABLE _ => g
54	| GG.NONSTABLE granted => let	| GG.NONSTABLE granted => let
55
56		(* this needs to be refined (perhaps) *)
57		val grpSrcInfo = (EM.defaultConsumer (), ref false)
58
59	val exports = #exports grec	val exports = #exports grec
60		val islib = #islib grec
61		val required = StringSet.difference (#required grec,
62		granted)
63		val grouppath = #grouppath grec
64		val subgroups = #subgroups grec
65
66	(* The format of a stable archive is the following:	(* The format of a stable archive is the following:
67	*  - It starts with the size s of the pickled dependency	*  - It starts with the size s of the pickled dependency
#	Line 53	Line 75
75	*  - Individual binfile contents (concatenated).	*  - Individual binfile contents (concatenated).
76	*)	*)
77
	val offsetDict = ref SmlInfoMap.empty
78	val members = ref []	val members = ref []
79	val registerOffset = let	val (registerOffset, getOffset) = let
80		val dict = ref SmlInfoMap.empty
81	val cur = ref 0	val cur = ref 0
82	fun reg (i, sz) = let	fun reg (i, sz) = let
83	val os = !cur	val os = !cur
84	in	in
85	cur := os + sz;	cur := os + sz;
86	offsetDict := SmlInfoMap.insert (!offsetDict, i, os);	dict := SmlInfoMap.insert (!dict, i, os);
87	members := i :: (!members);	members := i :: (!members);
88	os	os
89	end	end
90		fun get i = valOf (SmlInfoMap.find (!dict, i))
91	in	in
92	reg	(reg, get)
93	end	end
94
95	fun w_list w_item [] k m =	fun w_list w_item [] k m =
#	Line 183	Line 206
206
207	fun w_privileges p = w_list w_string (StringSet.listItems p)	fun w_privileges p = w_list w_string (StringSet.listItems p)
208
209	fun pickle_group (GG.GROUP g, granted) = let	fun pickle_group () = let
210	fun w_sg (GG.GROUP g) = w_abspath (#grouppath g)	fun w_sg (GG.GROUP g) = w_abspath (#grouppath g)
	val req' = StringSet.difference (#required g, granted)
211	fun k0 m = []	fun k0 m = []
212	val m0 = (0, Map.empty)	val m0 = (0, Map.empty)
213	in	in
214	concat	concat
215	(w_exports (#exports g)	(w_exports exports
216	(w_bool (#islib g)	(w_bool islib
217	(w_privileges req'	(w_privileges required
218	(w_abspath (#grouppath g)	(w_list w_sg subgroups k0))) m0)
	(w_list w_sg (#subgroups g) k0)))) m0)
219	end	end
220	val pickle = pickle_group (g, granted)
221		val pickle = pickle_group ()
222	val sz = size pickle	val sz = size pickle
223		val offset_adjustment = sz + 4
224
225		fun mkStableGroup () = let
226		val m = ref SmlInfoMap.empty
227		fun sn (DG.SNODE (n as { smlinfo, ... })) =
228		case SmlInfoMap.find (!m, smlinfo) of
229		SOME n => n
230		| NONE => let
231		val li = map sn (#localimports n)
232		val gi = map fsbn (#globalimports n)
233		val sourcepath = SmlInfo.sourcepath smlinfo
234		val spec = AbsPath.spec sourcepath
235		val offset =
236		getOffset smlinfo + offset_adjustment
237		val share = SmlInfo.share smlinfo
238		val locs = SmlInfo.errorLocation gp smlinfo
239		val error = EM.errorNoSource grpSrcInfo locs
240		val i = BinInfo.new { group = grouppath,
241		spec = spec,
242		offset = offset,
243		share = share,
244		error = error }
245		val n = DG.BNODE { bininfo = i,
246		localimports = li,
247		globalimports = gi }
248	in	in
249	Dummy.f ()	m := SmlInfoMap.insert (!m, smlinfo, n);
250		n
251	end	end
252
253	fun g (getGroup, bn2env, grpSrcInfo, group, s) = let	and sbn (DG.SB_SNODE n) = sn n
254		| sbn (DG.SB_BNODE n) = n
255
256		and fsbn (f, n) = (f, sbn n)
257
258		fun impexp ((f, n), e) = ((f, DG.SB_BNODE (sbn n)), e)
259
260		val exports = SymbolMap.map impexp (#exports grec)
261		val simap = genStableInfoMap (exports, grouppath)
262		in
263		GG.GROUP { exports = exports,
264		islib = islib,
265		required = required,
266		grouppath = grouppath,
267		subgroups = subgroups,
268		stableinfo = GG.STABLE simap }
269		end
270
271		fun writeInt32 (s, i) = let
272		val a = Word8Array.array (4, 0w0)
273		val _ = Pack32Big.update (a, 0, LargeWord.fromInt i)
274		in
275		BinIO.output (s, Word8Array.extract (a, 0, NONE))
276		end
277		in
278		writeInt32 (outs, sz);
279		BinIO.output (outs, Byte.stringToBytes pickle);
280		app (copyBin outs) (rev (!members));
281		mkStableGroup ()
282		end
283
284		fun g (getGroup, bn2env, group, s) = let
285
286		(* we don't care about errors... (?) *)
287		val grpSrcInfo = (EM.defaultConsumer (), ref false)
288
289	exception Format	exception Format
290
#	Line 413	Line 495
495	val exports = r_exports ()	val exports = r_exports ()
496	val islib = r_bool ()	val islib = r_bool ()
497	val required = r_privileges ()	val required = r_privileges ()
	val grouppath = r_abspath ()
498	val subgroups = r_list (getGroup o r_abspath) ()	val subgroups = r_list (getGroup o r_abspath) ()
499	(* find all the exported bnodes that are in the same group: *)	val simap = genStableInfoMap (exports, group)
	fun add (((_, DG.SB_BNODE (n as DG.BNODE b)), _), m) = let
	val i = #bininfo b
	in
	if AbsPath.compare (BinInfo.group i, group) = EQUAL then
	IntBinaryMap.insert (m, BinInfo.offset i, n)
	else m
	end
	| add (_, m) = m
	val simap = SymbolMap.foldl add IntBinaryMap.empty exports
500	in	in
501	GG.GROUP { exports = exports,	GG.GROUP { exports = exports,
502	islib = islib,	islib = islib,
503	required = required,	required = required,
504	grouppath = grouppath,	grouppath = group,
505	subgroups = subgroups,	subgroups = subgroups,
506	stableinfo = GG.STABLE simap }	stableinfo = GG.STABLE simap }
507	end	end

---

Colored Diff Long Colored Diff Unidiff Context Diff Side by Side

Legend: Removed from v.307   changed lines   Added in v.308

---

root@smlnj-gforge.cs.uchicago.edu	ViewVC Help
Powered by ViewVC 1.0.0