Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Diff of /sml/trunk/src/compiler/TopLevel/batch/batchutil.sml
ViewVC logotype

Diff of /sml/trunk/src/compiler/TopLevel/batch/batchutil.sml

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 93, Tue May 12 21:56:22 1998 UTC revision 100, Thu May 14 04:56:46 1998 UTC
# Line 6  Line 6 
6      structure Pid = PersStamps      structure Pid = PersStamps
7      structure Env = CMEnv.Env      structure Env = CMEnv.Env
8      structure Err = ErrorMsg      structure Err = ErrorMsg
9        structure CB = CompBasic
10    
11      exception FormatError      exception FormatError
12      exception NoCodeBug      exception NoCodeBug
# Line 23  Line 24 
24      type symenv = Env.symenv      type symenv = Env.symenv
25      type denv = Env.dynenv      type denv = Env.dynenv
26      type env = Env.environment      type env = Env.environment
27      type lambda = CompBasic.flint      type lambda = CB.flint
28    
29      type csegments = C.csegments      type csegments = C.csegments
30      type executable = C.executable      type executable = C.executable
# Line 34  Line 35 
35        | CLOSURE of executable        | CLOSURE of executable
36    
37      datatype 'iid cunit = CU of {      datatype 'iid cunit = CU of {
38          imports: pid list,          imports: C.import list,
39          exportPid: pid option,          exportPid: pid option,
40          references: 'iid,          references: 'iid,
41          staticPid: pid,          staticPid: pid,
# Line 73  Line 74 
74      infix >>      infix >>
75    
76    (*    (*
77     * layout of binfiles:   * BINFILE FORMAT description:
78     *  - 0..x-1:                 magic string (length = x)   *
79     *  - x..x+3:                 # of imports (= y)   *  Every 4-byte integer field is stored in big-endian format.
80     *  - x+4..x+7:               # of exports (= z)   *
81     *  - x+8..x+11:              size CM-info = (# of envPids) * bytesPerPid   *     Start Size Purpose
82     *  - x+12..x+15:             size lambda_i   * ----BEGIN OF HEADER----
83     *  - x+16..x+19:             size reserved area1   *          0 16  magic string
84     *  - x+20..x+23:             size reserved area2   *         16  4  number of import values (importCnt)
85     *  - x+24..x+27:             size code   *         20  4  number of exports (exportCnt = currently always 0 or 1)
86     *  - x+28..x+31:             size env   *         24  4  size of CM-specific info in bytes (cmInfoSzB)
87     *  - x+32..x+y+31:           import pids   *         28  4  size of pickled lambda-expression in bytes (lambdaSzB)
88     *  - x+y+32..x+y+z+31:       export pids   *         32  4  size of reserved area 1 in bytes (reserved1)
89     *  - ...                     CM-specific info (env pids)   *         36  4  size of reserved area 2 in bytes (reserved2)
90     *  -                         lambda_i   *         40  4  size of code area in bytes (codeSzB)
91     *  -                         reserved area1   *         44  4  size of pickled environment in bytes (envSzB)
92     *  -                         reserved area2   *         48  i  import trees [This area contains pickled import trees --
93     *  -                         code   *                  see below.  The total number of leaves in these trees is
94     *  -                         pickled_env   *                  importCnt.  The size impSzB of this area depends on the
95     *  EOF   *                  shape of the trees.]
96     *   *       i+48 ex  export pids [Each export pid occupies 16 bytes. Thus, the
97     * All counts and sizes are represented in big-endian layout.   *                  size ex of this area is 16*exportCnt (0 or 16).]
98     * This should be tracked by the run-time system header file   *    ex+i+48 cm  CM info [Currently a list of pid-pairs.] (cm = cmInfoSzB)
99     * "runtime/include/bin-file.h"   * ----END OF HEADER----
100     *          0  h  HEADER (h = 48+cm+ex+i)
101     *          h  l  pickle of exported lambda-expr. (l = lambdaSzB)
102     *        l+h  r  reserved areas (r = reserved1+reserved2)
103     *      r+l+h  c  code area (c = codeSzB) [Structured into several
104     *                  segments -- see below.]
105     *    c+r+l+h  e  pickle of static environment (e = envSzB)
106     *  e+c+r+l+h  -  END OF BINFILE
107     *
108     * IMPORT TREE FORMAT description:
109     *
110     *  The import tree area contains a list of (pid * tree) pairs.
111     *  The pids are stored directly as 16-byte strings.
112     *  Trees are constructed according to the following ML-datatype:
113     *    datatype tree = NODE of (int * tree) list
114     *  Leaves in this tree have the form (NODE []).
115     *  Trees are written recursively -- (NODE l) is represented by n (= the
116     *  length of l) followed by n (int * node) subcomponents.  Each component
117     *  consists of the integer selector followed by the corresponding tree.
118     *
119     *  The size of the import tree area is only given implicitly. When reading
120     *  this area, the reader must count the number of leaves and compare it
121     *  with importCnt.
122     *
123     *  Integer values in the import tree area (lengths and selectors) are
124     *  written in "packed" integer format. In particular, this means that
125     *  Values in the range 0..127 are represented by only 1 byte.
126     *  Conceptually, the following pickling routine is used:
127     *
128     *    void recur_write_ul (unsigned long l, FILE *file)
129     *    {
130     *      if (l != 0) {
131     *        recur_write_ul (l / 0200, file);
132     *        putc ((l % 0200) | 0200, file);
133     *      }
134     *    }
135     *
136     *    void write_ul (unsigned long l, FILE *file)
137     *    {
138     *      recur_write_ul (l / 0200, file);
139     *      putc (l % 0200, file);
140     *    }
141     *
142     * CODE AREA FORMAT description:
143     *
144     *  The code area contains multiple code segements.  There will be at least
145     *  two.  The very first segment is the "data" segment -- responsible for
146     *  creating literal constants on the heap.  The idea is that code in the
147     *  data segment will be executed only once at link-time. Thus, it can
148     *  then be garbage-collected immediatly. (In the future it is possible that
149     *  the data segment will not contain executable code at all but some form
150     *  of bytecode that is to be interpreted separately.)
151     *
152     *  In the binfile, each code segment is represented by its size s (in
153     *  bytes -- written as a 4-byte big-endian integer) followed by s bytes of
154     *  machine- (or byte-) code. The total length of all code segments
155     *  (including the bytes spent on representing individual sizes) is codeSzB.
156     *
157     * LINKING CONVENTIONS:
158     *
159     *  Linking is achieved by executing all code segments in sequential order.
160     *
161     *  The first code segment (i.e., the "data" segment) receives unit as
162     *  its single argument.
163     *
164     *  The second code segment receives a record as its single argument.
165     *  This record has (importCnt+1) components.  The first importCnt
166     *  components correspond to the leaves of the import trees.  The final
167     *  component is the result from executing the data segment.
168     *
169     *  All other code segments receive a single argument which is the result
170     *  of the preceding segment.
171     *
172     *  The result of the last segment represents the exports of the compilation
173     *  unit.  It is to be paired up with the export pid and stored in the
174     *  dynamic environment.  If there is no export pid, then the final result
175     *  will be thrown away.
176     *
177     *  The import trees are used for constructing the argument record for the
178     *  second code segment.  The pid at the root of each tree is the key for
179     *  looking up a value in the existing dynamic environment.  In general,
180     *  that value will be a record.  The selector fields of the import tree
181     *  associated with the pid are used to recursively fetch components of that
182     *  record.
183     *)     *)
184    
185      val MAGIC = let      val MAGIC = let
# Line 132  Line 216 
216    
217      fun readInt32 s = LargeWord.toIntX(Pack32Big.subVec(bytesIn(s, 4), 0))      fun readInt32 s = LargeWord.toIntX(Pack32Big.subVec(bytesIn(s, 4), 0))
218    
219        fun readPackedInt32 s = let
220            fun loop n =
221                case BinIO.input1 s of
222                    NONE => error "unable to read a packed int32"
223                  | SOME w8 => let
224                        val n' =
225                            n * 0w128 + Word8.toLargeWord (Word8.andb (w8, 0w127))
226                    in
227                        if Word8.andb (w8, 0w128) = 0w0 then n' else loop n'
228                    end
229        in
230            LargeWord.toIntX (loop 0w0)
231        end
232    
233      fun readPid s = Pid.fromBytes (bytesIn (s, bytesPerPid))      fun readPid s = Pid.fromBytes (bytesIn (s, bytesPerPid))
234      fun readPidList (s, n) = List.tabulate (n, fn _ => readPid s)      fun readPidList (s, n) = List.tabulate (n, fn _ => readPid s)
235    
236      fun writeInt32 s i =  let      fun readImportTree s =
237            case readPackedInt32 s of
238                0 =>  (CB.ITNODE [], 1)
239              | cnt => let
240                    fun readImportList 0 = ([], 0)
241                      | readImportList cnt = let
242                            val selector = readPackedInt32 s
243                            val (tree, n) = readImportTree s
244                            val (rest, n') = readImportList (cnt - 1)
245                        in
246                            ((selector, tree) :: rest, n + n')
247                        end
248                    val (l, n) = readImportList cnt
249                in
250                    (CB.ITNODE l, n)
251                end
252    
253        fun readImports (s, n) =
254            if n <= 0 then []
255            else let
256                val pid = readPid s
257                val (tree, n') = readImportTree s
258                val rest = readImports (s, n - n')
259            in
260                (pid, tree) :: rest
261            end
262    
263        fun pickleInt32 i = let
264            val w = fromInt i            val w = fromInt i
265            fun out w = BinIO.output1 (s, toByte w)          fun out w = toByte w
266        in
267            Word8Vector.fromList [toByte (w >> 0w24), toByte (w >> 0w16),
268                                  toByte (w >> 0w8), toByte w]
269        end
270        fun writeInt32 s i = BinIO.output (s, pickleInt32 i)
271    
272        fun picklePackedInt32 i = let
273            val n = fromInt i
274            val // = LargeWord.div
275            val %% = LargeWord.mod
276            val !! = LargeWord.orb
277            infix // %% !!
278            val toW8 = Word8.fromLargeWord
279            fun r (0w0, l) = Word8Vector.fromList l
280              | r (n, l) = r (n // 0w128, toW8 ((n %% 0w128) !! 0w128) :: l)
281            in            in
282              out (w >> 0w24); out (w >> 0w16);  out (w >> 0w8); out w          r (n // 0w128, [toW8 (n %% 0w128)])
283            end            end
284    
285      fun writePid (s, pid) = BinIO.output (s, Pid.toBytes pid)      fun writePid (s, pid) = BinIO.output (s, Pid.toBytes pid)
286      fun writePidList (s, l) = app (fn p => writePid (s, p)) l      fun writePidList (s, l) = app (fn p => writePid (s, p)) l
287    
288        local
289            fun pickleImportSpec ((selector, tree), (n, p)) = let
290                val sp = picklePackedInt32 selector
291                val (n', p') = pickleImportTree (tree, (n, p))
292            in
293                (n', sp :: p')
294            end
295            and pickleImportTree (CB.ITNODE [], (n, p)) =
296                (n + 1, picklePackedInt32 0 :: p)
297              | pickleImportTree (CB.ITNODE l, (n, p)) = let
298                    val (n', p') = foldr pickleImportSpec (n, p) l
299                in
300                    (n', picklePackedInt32 (length l) :: p')
301                end
302    
303            fun pickleImport ((pid, tree), (n, p)) = let
304                val (n', p') = pickleImportTree (tree, (n, p))
305            in
306                (n', Pid.toBytes pid :: p')
307            end
308        in
309            fun pickleImports l = let
310                val (n, p) = foldr pickleImport (0, []) l
311            in
312                (n, Word8Vector.concat p)
313            end
314        end
315    
316      fun checkMagic s =      fun checkMagic s =
317            if (bytesIn (s, magicBytes)) = MAGIC then () else error "bad magic number"            if (bytesIn (s, magicBytes)) = MAGIC then ()
318              else error "bad magic number"
319    
320      fun readHeader s = let      fun readHeader s = let
321            val _ = checkMagic s            val _ = checkMagic s
322            val ni = readInt32 s            val leni = readInt32 s
323            val ne = readInt32 s            val ne = readInt32 s
324            val cmInfoSzB = readInt32 s            val cmInfoSzB = readInt32 s
325            val nei = cmInfoSzB div bytesPerPid            val nei = cmInfoSzB div bytesPerPid
# Line 159  Line 328 
328            val sa2 = readInt32 s            val sa2 = readInt32 s
329            val cs = readInt32 s            val cs = readInt32 s
330            val es = readInt32 s            val es = readInt32 s
331            val imports = readPidList (s, ni)            val imports = readImports (s, leni)
332            val exportPid = (case ne            val exportPid = (case ne
333                   of 0 => NONE                   of 0 => NONE
334                    | 1 => SOME(readPid s)                    | 1 => SOME(readPid s)
# Line 169  Line 338 
338            in            in
339              case envPids              case envPids
340               of (st :: lm :: references) => {               of (st :: lm :: references) => {
341                    nImports = ni, nExports = ne,                    nExports = ne,
342                    lambdaSz = sLam,                    lambdaSz = sLam,
343                    res1Sz = sa1, res2Sz = sa2, codeSz = cs, envSz = es,                    res1Sz = sa1, res2Sz = sa2, codeSz = cs, envSz = es,
344                    imports = imports, exportPid = exportPid,                    imports = imports, exportPid = exportPid,
# Line 190  Line 359 
359            end            end
360    
361      fun readUnit {name=n, stream = s, pids2iid, senv = context, keep_code} = let      fun readUnit {name=n, stream = s, pids2iid, senv = context, keep_code} = let
362          val { nImports = ni, nExports = ne, lambdaSz = sa2,          val { nExports = ne, lambdaSz = sa2,
363                res1Sz, res2Sz, codeSz = cs, envSz = es,                res1Sz, res2Sz, codeSz = cs, envSz = es,
364                imports, exportPid, references,                imports, exportPid, references,
365                staticPid, lambdaPid                staticPid, lambdaPid
# Line 206  Line 375 
375                  end                  end
376          val _ = if res1Sz = 0 andalso res2Sz = 0          val _ = if res1Sz = 0 andalso res2Sz = 0
377                then () else error "non-zero reserved size"                then () else error "non-zero reserved size"
378          val code = (case readCodeList (s, cs)          val code = (case readCodeList (s, cs) of
379                 of [] => error "missing code objects"                          data :: c0 :: cn => { data = data, c0 = c0, cn = cn,
380                  | c0 :: cn => { c0 = c0, cn = cn, name=ref(SOME(n)) }                                                name = ref (SOME n) }
381                (* end case *))                        | _ => error "missing code objects")
382          val penv = bytesIn (s, es)          val penv = bytesIn (s, es)
383          val _ = if Word8Vector.length penv = es andalso BinIO.endOfStream s          val _ = if Word8Vector.length penv = es andalso BinIO.endOfStream s
384                  then ()                  then ()
# Line 228  Line 397 
397          end          end
398    
399      fun writeUnit {stream = s, cunit = u, keep_code, iid2pids} = let      fun writeUnit {stream = s, cunit = u, keep_code, iid2pids} = let
400            val CU{          val CU { imports, exportPid, references,
                   imports, exportPid, references,  
401                    staticPid, penv,                    staticPid, penv,
402                    lambdaPid, lambda, plambda, ...                    lambdaPid, lambda, plambda, ...
403                  } = u                  } = u
404            val envPids = staticPid :: lambdaPid :: iid2pids references            val envPids = staticPid :: lambdaPid :: iid2pids references
405            val ni = length imports          val (leni, picki) = pickleImports imports
406            val (ne, epl) = (case exportPid of NONE => (0, [])          val (ne, epl) =
407                (case exportPid of
408                     NONE => (0, [])
409                                             | SOME p => (1, [p]))                                             | SOME p => (1, [p]))
410            val nei = length envPids            val nei = length envPids
411            val cmInfoSzB = nei * bytesPerPid            val cmInfoSzB = nei * bytesPerPid
412            val sa2 = (case lambda of NONE => 0          val sa2 =
413                (case lambda of
414                     NONE => 0
415                                    | _ => Word8Vector.length plambda)                                    | _ => Word8Vector.length plambda)
416            val res1Sz = 0            val res1Sz = 0
417            val res2Sz = 0            val res2Sz = 0
418            val { c0, cn , ...} = codeSegments u          val { data, c0, cn , ...} = codeSegments u
419            fun csize c = (Word8Vector.length c) + 4 (* including size field *)            fun csize c = (Word8Vector.length c) + 4 (* including size field *)
420            val cs = foldl (fn (c, a) => (csize c) + a) (csize c0) cn          val cs = foldl (fn (c, a) => (csize c) + a) (csize c0 +csize data) cn
421            fun codeOut c = (          fun codeOut c = (writeInt32 s (Word8Vector.length c);
                 writeInt32 s (Word8Vector.length c);  
422                  BinIO.output (s, c))                  BinIO.output (s, c))
423          in          in
424            BinIO.output (s, MAGIC);            BinIO.output (s, MAGIC);
425            app (writeInt32 s) [ni, ne, cmInfoSzB];          app (writeInt32 s) [leni, ne, cmInfoSzB];
426            app (writeInt32 s) [sa2, res1Sz, res2Sz, cs];            app (writeInt32 s) [sa2, res1Sz, res2Sz, cs];
427            writeInt32 s (Word8Vector.length penv);            writeInt32 s (Word8Vector.length penv);
428            writePidList (s, imports);          BinIO.output (s, picki);
429            writePidList (s, epl);            writePidList (s, epl);
430          (* arena1 *)          (* arena1 *)
431            writePidList (s, envPids);            writePidList (s, envPids);
432          (* arena2 *)          (* arena2 *)
433            case lambda of NONE => () | _ => BinIO.output (s, plambda);          case lambda of
434                NONE => ()
435              | _ => BinIO.output (s, plambda);
436          (* arena3 is empty *)          (* arena3 is empty *)
437          (* arena4 is empty *)          (* arena4 is empty *)
438          (* code objects *)          (* code objects *)
439            codeOut data;
440            codeOut c0;            codeOut c0;
441            app codeOut cn;            app codeOut cn;
442            BinIO.output (s, penv);            BinIO.output (s, penv);
# Line 322  Line 496 
496    
497      fun execUnit (u, denv) = let      fun execUnit (u, denv) = let
498          val ndenv =          val ndenv =
499              C.execute { executable = codeClosure u,              C.execute { executable = C.isolate(codeClosure u),
500                          imports = importsCU u,                          imports = importsCU u,
501                          exportPid = exportCU u,                          exportPid = exportCU u,
502                          dynenv = denv }                          dynenv = denv }

Legend:
Removed from v.93  
changed lines
  Added in v.100

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