
    <<MBOutput.mesa   >>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Sandman on 6-Aug-81 15:41:43>>
        <<Lewis on 25-Sep-81 15:01:46>>
        <<Levin on January 16, 1984 11:26 am>>
        <<Russ Atkinson on March 8, 1985 5:27:35 pm PST>>

    DIRECTORY
        Ascii USING [CR],
        Basics USING [bytesPerWord, LongMult, LongNumber],
        BasicTime USING [GMT, ToPupTime],
        BcdDefs USING [MTHandle],
        BootFile USING [currentVersion, Entry, Header, maxEntriesPerHeader, maxEntriesPerTrailer, MemorySizeToFileSize, PageStateFromFlags, 
        Trailer],
        BootStartList USING [Base, Entry, SwapUnitIndex, SwapUnitInfo],
        FS USING [Close, Open, OpenFile, OpenFileFromStream, Read, SetByteCountAndCreatedTime, StreamOpen],
        IO USING [bool, card, Close, GetIndex, GetLength, PutChar, PutF, PutRope, rope, SetIndex, SetLength, STREAM, UnsafePutBlock],
        IOClasses USING [Copy],
        MB USING [BHandle, DoAllModules, DumpSegs, Handle, StartControlLink],
        MBVM USING [BackingForSeg, Base, CodePiece, CodePieceList, CodeSeg, CopyRead, CopyWrite, DataSeg, FileBase, FileSeg, GetPage, Seg, 
        Segs, SortSegs, Write],
        PrincOps USING [bytesPerPage, flagsClean, flagsReadOnly, GlobalFrame, PageFlags, PageNumber, PageValue, wordsPerPage],
        PrincOpsUtils USING [LowHalf, LongZero],
        Rope USING [Length, ROPE],
        VM USING [AddressForPageNumber, Allocate, Free, Interval, PageNumberForAddress];

    MBOutput: CEDAR PROGRAM
        IMPORTS Basics, BasicTime, BootFile, FS, IO, IOClasses, MB, MBVM, PrincOpsUtils, Rope, VM
        EXPORTS MB = BEGIN OPEN MBVM;

    EntrySeq: TYPE = LONG POINTER TO EntrySeqRep;
    EntrySeqRep: TYPE = RECORD [SEQUENCE COMPUTED CARDINAL OF BootFile.Entry];

    wordsPerPage: CARDINAL = PrincOps.wordsPerPage;
    bytesPerWord: CARDINAL = Basics.bytesPerWord;
    bytesPerPage: CARDINAL = PrincOps.bytesPerPage;

    PageOfWords: TYPE = ARRAY [0..wordsPerPage) OF WORD;

    data: MB.Handle _ NIL;

    header: REF BootFile.Header _ NIL;
    trailer: REF BootFile.Trailer _ NIL;
    nEntries, currentEntry: CARDINAL;
    filePage: MBVM.Base;
    trailerIndex: LONG CARDINAL;

    EtherHeader: TYPE = MACHINE DEPENDENT RECORD [
        version(0): CARDINAL _ 1,
        mustBeZero(1): LONG CARDINAL _ 0,
        createTime(3): BCPLTime
        <<the following are implicit>>
        <<name(5): StringBody,>>
        <<fill(5+WordsForString[name]): ARRAY [5+WordsForString[name]..wordsPerPage) OF WORD _ ALL[0]>>
        ];

    BCPLTime: TYPE = MACHINE DEPENDENT RECORD [high, low: CARDINAL];

    InitOutput: PUBLIC PROC [h: MB.Handle] = {data _ h};

    FinishOutput: PUBLIC PROC = {
        IF data.bootStream ~= NIL THEN {data.bootStream.Close[abort: TRUE]; data.bootStream _ NIL};
        header _ NIL;
        trailer _ NIL;
        data _ NIL;
        };

    <<Boot file (not germ) output>>

    PreScanSegsForOutput: PUBLIC PROC [segs: MBVM.Segs]
        RETURNS [lastBootedPage: PrincOps.PageNumber] = TRUSTED {
        scriptBase: BootStartList.Base = data.scriptBase;
        nFilePages: CARDINAL _ 0;
        data.nBootLoadedPages _ 0;
        FOR i: CARDINAL IN [0..segs.length) DO
            seg: MBVM.Seg = segs[i];
            su: LONG POINTER TO swapUnit BootStartList.Entry = @scriptBase[seg.index];
            WITH s: seg SELECT FROM
                data =>
                    IF scriptBase[su.parent].bootLoaded THEN {
                        IF s.base = 376B THEN IF s.pages ~= 1 THEN ERROR ELSE LOOP;  -- ugh!
                        IF su.info.state = resident THEN
                            data.nResidentPages _ data.nResidentPages + su.pages;
                        data.nBootLoadedPages _ data.nBootLoadedPages + su.pages;
                        lastBootedPage _
                            MAX[lastBootedPage, scriptBase[su.parent].vmPage + su.base + su.pages - 1];
                        };
                code => {
                    nUnits: CARDINAL = IF s.sph = NIL THEN 1 ELSE s.sph.length;
                    index: BootStartList.SwapUnitIndex _ s.index;
                    THROUGH [0..nUnits) DO
                        su: LONG POINTER TO swapUnit BootStartList.Entry = @scriptBase[index];
                        IF scriptBase[su.parent].bootLoaded THEN {
                            IF su.info.state = resident THEN
                                data.nResidentPages _ data.nResidentPages + su.pages;
                            data.nBootLoadedPages _ data.nBootLoadedPages + su.pages;
                            lastBootedPage _
                                MAX[lastBootedPage, scriptBase[su.parent].vmPage + su.base + su.pages - 1];
                            };
                        index _ index + SIZE[swapUnit BootStartList.Entry];
                        ENDLOOP;
                    };
                file =>
                    IF scriptBase[su.parent].bootLoaded THEN {
                        IF su.info.state = resident THEN
                            data.nResidentPages _ data.nResidentPages + s.pages;
                        data.nBootLoadedPages _ data.nBootLoadedPages + s.pages;
                        lastBootedPage _ s.base + s.pages - 1;
                        };
                ENDCASE;
            ENDLOOP;
        nFilePages _ BootFile.MemorySizeToFileSize[data.nBootLoadedPages];
        FOR i: CARDINAL IN [0..segs.length) DO
            seg: MBVM.Seg = segs[i];
            su: LONG POINTER TO swapUnit BootStartList.Entry = @scriptBase[seg.index];
            WITH s: seg SELECT FROM
                data =>
                    IF AppendNecessary[su] THEN {
                        scriptBase[su.parent].backingStore _ self;
                        IF scriptBase[su.parent].backingPage = 0 THEN
                            scriptBase[su.parent].backingPage _ nFilePages;
                        nFilePages _ nFilePages + su.pages;
                        };
                code => {
                    nUnits: CARDINAL = IF s.sph = NIL THEN 1 ELSE s.sph.length;
                    index: BootStartList.SwapUnitIndex _ s.index;
                    THROUGH [0..nUnits) DO
                        su: LONG POINTER TO swapUnit BootStartList.Entry = @scriptBase[index];
                        IF AppendNecessary[su] THEN {
                            scriptBase[su.parent].backingStore _ self;
                            IF scriptBase[su.parent].backingPage = 0 THEN
                                scriptBase[su.parent].backingPage _ nFilePages;
                            nFilePages _ nFilePages + su.pages;
                            };
                        index _ index + SIZE[swapUnit BootStartList.Entry];
                        ENDLOOP;
                    };
                file =>
                    IF AppendNecessary[su] THEN {
                        scriptBase[su.parent].backingStore _ self;
                        IF scriptBase[su.parent].backingPage = 0 THEN
                            scriptBase[su.parent].backingPage _ nFilePages;
                        nFilePages _ nFilePages + s.pages;
                        };
                ENDCASE;
            ENDLOOP;
        data.nFilePages _ nFilePages;
        };

    WriteBootFile: PUBLIC PROC = {
        data.typescript.PutRope["Writing boot file..."];
        InitializeBootFile[];
        WriteVM[];
        FinalizeBootFile[];
        data.typescript.PutRope["finished writing.\N"];
        IF data.etherFormat THEN MakeEtherFile[];
        };

    InitializeBootFile: PROC = {
        data.bootStream _ FS.StreamOpen[
            fileName: data.output,
            accessOptions: $create,
            createByteCount: Basics.LongMult[data.nFilePages, bytesPerPage],
            streamOptions: []
            ];
        data.bootStream.SetLength[bytesPerPage];
        data.bootStream.SetIndex[bytesPerPage];
        TRUSTED {
            data.bootHeader _ header _ LOOPHOLE[NEW[PageOfWords]];
            PrincOpsUtils.LongZero[LOOPHOLE[header], wordsPerPage];
            header^ _ BootFile.Header[
                creationDate: BasicTime.ToPupTime[data.buildTime],
                pStartListHeader: PrincOpsUtils.LowHalf[data.scriptBaseInVM],
                inLoadMode: load,
                continuation: [vp: initial[mdsi: [data.mdsBase/256], destination: MB.StartControlLink[]]],
                countData: data.nBootLoadedPages,
                entries:
                ];
            };
        trailer _ NIL;
        nEntries _ BootFile.maxEntriesPerHeader;
        currentEntry _ 0;
        filePage _ 1;
        };

    FinalizeBootFile: PROC = {
        file: FS.OpenFile = FS.OpenFileFromStream[data.bootStream];
        data.bootStream.SetIndex[0];
        data.bootStream.UnsafePutBlock[
            block: [base: LOOPHOLE[header], startIndex: 0, count: bytesPerPage]];
        data.bootStream.Close[];
        data.bootStream _ NIL;
        <<Now set the create time to the desired value>>
        file.SetByteCountAndCreatedTime[created: data.buildTime];
        file.Close[];
        };

    WriteVM: PROC = {
        segs: MBVM.Segs = MBVM.SortSegs[];
        scriptBase: BootStartList.Base = data.scriptBase;
        loadmap: IO.STREAM = data.loadmap;
        loadmap.PutRope["\N\NBOOT FILE MAP\N\N"];
        BootloadedHeadingToLoadmap["   Bootloaded Memory\N"];
        loadmap.PutF["%6n  Header Page\N", IO.card[filePage-1]];  -- header page
        data.typescript.PutRope["bootloaded memory..."];
        FOR i: CARDINAL IN [0..segs.length) DO
            WITH segs[i] SELECT FROM
                s: MBVM.DataSeg => WriteDataSeg[s];
                s: MBVM.CodeSeg => WriteCodeSeg[s];
                s: MBVM.FileSeg => WriteFileSeg[s];
                ENDCASE;
            ENDLOOP;
        IF trailer ~= NIL THEN [] _ WriteTrailerPage[];
        NonBootloadedHeadingToLoadmap["\N   Non-Bootloaded Memory\N"];
        data.typescript.PutRope["non-bootloaded memory..."];
        FOR i: CARDINAL IN [0..segs.length) DO
            WITH segs[i] SELECT FROM
                s: MBVM.DataSeg => AppendDataSeg[s];
                s: MBVM.CodeSeg => AppendCodeSeg[s];
                s: MBVM.FileSeg => AppendFileSeg[s];
                ENDCASE;
            ENDLOOP;
        loadmap.PutF["\N\NBoot file pages: %n (%n bootloaded, of which %n are resident)\N",
            IO.card[data.nFilePages], IO.card[data.nBootLoadedPages], IO.card[data.nResidentPages]];
        };

    WriteDataSeg: PROC [seg: MBVM.DataSeg] = TRUSTED {
        scriptBase: BootStartList.Base = data.scriptBase;
        su: LONG POINTER TO swapUnit BootStartList.Entry = @scriptBase[seg.index];
        v: PrincOps.PageValue = MapValueForSeg[seg];
        IF ~scriptBase[su.parent].bootLoaded THEN RETURN;
        IF seg.base = 376B THEN IF seg.pages ~= 1 THEN ERROR ELSE RETURN;  -- ugh!
        BootloadedSegToLoadmap[seg, filePage, v.state.flags];
        FOR page: CARDINAL IN [seg.base..seg.base+seg.pages) DO
            lp: LONG POINTER;
            EnterPage[page: page, value: v];
            lp _ MBVM.GetPage[page];
            IF lp = NIL THEN WriteEmptyPage[] ELSE WritePage[lp];
            ENDLOOP;
        };

    WriteCodeSeg: PROC [seg: MBVM.CodeSeg] = TRUSTED {
        nUnits: CARDINAL = IF seg.sph = NIL THEN 1 ELSE seg.sph.length;
        scriptBase: BootStartList.Base = data.scriptBase;
        index: BootStartList.SwapUnitIndex _ seg.index;
        v: PrincOps.PageValue = MapValueForSeg[seg];
        base: LONG POINTER;
        offset: CARDINAL _ 0;
        pieceList: MBVM.CodePieceList _ seg.pieces;
        THROUGH [0..nUnits) DO
            su: LONG POINTER TO swapUnit BootStartList.Entry = @scriptBase[index];
            IF scriptBase[su.parent].bootLoaded THEN EXIT;
            index _ index + SIZE[swapUnit BootStartList.Entry];
            REPEAT
                FINISHED => RETURN;
            ENDLOOP;
        base _ OpenSegForTransfer[seg];
        {ENABLE UNWIND => CloseSegAfterTransfer[seg, base];
            IF seg.sph = NIL THEN {
                BootloadedSegToLoadmap[seg, filePage, v.state.flags];
                FOR page: CARDINAL IN [seg.base..seg.base+seg.pages) DO
                    EnterPage[page: page, value: v];
                    <<we can't take the following two line out of the loop because of the way trailer pages interleave with other pages of the boot 
                    file.>>
                    pieceList _ WriteCodeWords[base, offset, wordsPerPage, pieceList];
                    filePage _ filePage + 1;
                    offset _ offset + wordsPerPage;
                    ENDLOOP;
                }
            ELSE {
                index: BootStartList.SwapUnitIndex _ seg.index;
                THROUGH [0..nUnits) DO
                    su: LONG POINTER TO swapUnit BootStartList.Entry = @scriptBase[index];
                    IF scriptBase[su.parent].bootLoaded THEN {
                        BootloadedSwapUnitToLoadmap[index, filePage, v.state.flags, seg];
                        FOR i: CARDINAL IN CARDINAL[0..su.pages) DO
                            EnterPage[page: scriptBase[su.parent].vmPage + su.base + i, value: v];
                            pieceList _ WriteCodeWords[base, offset, wordsPerPage, pieceList];
                            filePage _ filePage + 1;
                            offset _ offset + wordsPerPage;
                            ENDLOOP;
                        }
                    ELSE offset _ offset + su.pages*wordsPerPage;
                    index _ index + SIZE[swapUnit BootStartList.Entry];
                    ENDLOOP;
                };
            };
        CloseSegAfterTransfer[seg, base];
        };

    WriteFileSeg: PROC [seg: MBVM.FileSeg] = TRUSTED {
        scriptBase: BootStartList.Base = data.scriptBase;
        su: LONG POINTER TO swapUnit BootStartList.Entry = @scriptBase[seg.index];
        v: PrincOps.PageValue = MapValueForSeg[seg];
        base: LONG POINTER;
        IF ~scriptBase[su.parent].bootLoaded THEN RETURN;
        base _ OpenSegForTransfer[seg];
        {ENABLE UNWIND => CloseSegAfterTransfer[seg, base];
            lp: LONG POINTER _ base;
            BootloadedSegToLoadmap[seg, filePage, v.state.flags];
            FOR page: CARDINAL IN [seg.base..seg.base+seg.pages) DO
                EnterPage[page: page, value: v];
                WritePage[lp];
                lp _ lp + wordsPerPage;
                ENDLOOP;
            };
        CloseSegAfterTransfer[seg, base];
        };

    AppendDataSeg: PROC [seg: MBVM.DataSeg] = TRUSTED {
        IF ~AppendNecessary[@data.scriptBase[seg.index]] THEN RETURN;
        SegToLoadmap[seg, filePage];
        FOR page: CARDINAL IN [seg.base..seg.base+seg.pages) DO
            lp: LONG POINTER = MBVM.GetPage[page];
            IF lp = NIL THEN WriteEmptyPage[] ELSE WritePage[lp];
            ENDLOOP;
        };

    AppendCodeSeg: PROC [seg: MBVM.CodeSeg] = TRUSTED {
        nUnits: CARDINAL = IF seg.sph = NIL THEN 1 ELSE seg.sph.length;
        index: BootStartList.SwapUnitIndex _ seg.index;
        scriptBase: BootStartList.Base = data.scriptBase;
        base: LONG POINTER;
        THROUGH [0..nUnits) DO
            su: LONG POINTER TO swapUnit BootStartList.Entry = @scriptBase[index];
            IF AppendNecessary[su] THEN EXIT;
            index _ index + SIZE[swapUnit BootStartList.Entry];
            REPEAT
                FINISHED => RETURN;
            ENDLOOP;
        base _ OpenSegForTransfer[seg];
        {ENABLE UNWIND => CloseSegAfterTransfer[seg, base];
            IF seg.sph = NIL THEN {
                SegToLoadmap[seg, filePage];
                [] _ WriteCodeWords[base, 0, seg.pages*wordsPerPage, seg.pieces];
                filePage _ filePage + seg.pages;
                }
            ELSE {
                offset: CARDINAL _ 0;
                pieceList: MBVM.CodePieceList _ seg.pieces;
                index: BootStartList.SwapUnitIndex _ seg.index;
                THROUGH [0..nUnits) DO
                    su: LONG POINTER TO swapUnit BootStartList.Entry = @scriptBase[index];
                    IF AppendNecessary[su] THEN {
                        SwapUnitToLoadmap[index, filePage, seg];
                        pieceList _ WriteCodeWords[base, offset, su.pages*wordsPerPage, pieceList];
                        filePage _ filePage + su.pages;
                        };
                    offset _ offset + su.pages*wordsPerPage;
                    index _ index + SIZE[swapUnit BootStartList.Entry];
                    ENDLOOP;
                };
            };
        CloseSegAfterTransfer[seg, base];
        };

    AppendFileSeg: PROC [seg: MBVM.FileSeg] = TRUSTED {
        base: LONG POINTER;
        IF ~AppendNecessary[@data.scriptBase[seg.index]] THEN RETURN;
        base _ OpenSegForTransfer[seg];
        {ENABLE UNWIND => CloseSegAfterTransfer[seg, base];
            lp: LONG POINTER _ base;
            SegToLoadmap[seg, filePage];
            IF data.debug THEN {
                loadmap: IO.STREAM = data.loadmap;
                index: BootStartList.SwapUnitIndex _ seg.index;
                loadmap.PutF["%sSwapUnits[", IO.card[26]];
                FOR i: CARDINAL IN [0..seg.nUnits) DO
                    loadmap.PutF["%n", IO.card[LOOPHOLE[index].LONG]];
                    IF i ~= seg.nUnits - 1 THEN loadmap.PutRope[", "];
                    index _ index + SIZE[swapUnit BootStartList.Entry];
                    ENDLOOP;
                loadmap.PutRope["]\N"];
                };
            FOR i: CARDINAL IN [0..seg.pages) DO
                WritePage[lp];
                lp _ lp + wordsPerPage;
                ENDLOOP;
            };
        CloseSegAfterTransfer[seg, base];
        };

    AppendNecessary: PROC [su: LONG POINTER TO swapUnit BootStartList.Entry]
        RETURNS [BOOL] = TRUSTED {RETURN[~data.scriptBase[su.parent].bootLoaded]};
    <<>>
    <<Germ file output>>

    GermMDS: CARDINAL = 37000B;
    BootXferLocation: POINTER = LOOPHOLE[1376B];
    GermPageCountLocation: POINTER = LOOPHOLE[1377B];

    WriteGermFile: PUBLIC PROC = {
        data.typescript.PutRope["Writing germ file..."];
        InitializeGermFile[];
        data.nFilePages _ data.nResidentPages _ data.nBootLoadedPages _ WriteGerm[];
        FinalizeGermFile[];
        data.typescript.PutRope["finished writing.\N"];
        IF data.etherFormat THEN MakeEtherFile[];
        };

    InitializeGermFile: PROC = {
        data.bootStream _ FS.StreamOpen[fileName: data.output, accessOptions: $create];
        filePage _ 0;
        };

    FinalizeGermFile: PROC = {
        <<RRA fix: January 23, 1984>>
        file: FS.OpenFile;
        data.bootStream.SetLength[Basics.LongMult[data.nFilePages, bytesPerPage]];
        data.bootStream.Close[];
        data.bootStream _ NIL;
        <<Now set the create time to the desired value>>
        file _ FS.Open[name: data.output, lock: $write];
        file.SetByteCountAndCreatedTime[created: data.buildTime];
        file.Close[];
        };

    WriteGerm: PROC RETURNS [germPages: CARDINAL _ 0] = {
        segs: MBVM.Segs = MBVM.SortSegs[];
        relocationPages: CARDINAL;
        RelocateGerm: PROC = {
            codeRelocation: LONG CARDINAL =
                Basics.LongMult[(relocationPages _ GermMDS - data.mdsBase), wordsPerPage];
            RelocateOneModule: PROC [loadee: MB.BHandle, mth: BcdDefs.MTHandle]
                RETURNS [BOOL] = TRUSTED {
                gf: PrincOps.GlobalFrame;
                MBVM.CopyRead[from: loadee.mt[mth.gfi].frame, to: @gf, nwords: SIZE[PrincOps.GlobalFrame]];
                gf.code.longbase _ gf.code.longbase + codeRelocation;
                MBVM.CopyWrite[to: loadee.mt[mth.gfi].frame, from: @gf, nwords: SIZE[PrincOps.GlobalFrame]];
                RETURN[FALSE]
                };
            [] _ MB.DoAllModules[RelocateOneModule];
            };
        IF data.debug THEN MB.DumpSegs[segs, "WRITING GERM"];
        RelocateGerm[];
        FOR i: CARDINAL IN [0..segs.length) DO germPages _ germPages + segs[i].pages; ENDLOOP;
        MBVM.Write[p: BootXferLocation, v: MB.StartControlLink[]];
        MBVM.Write[p: GermPageCountLocation, v: germPages];
        BootloadedHeadingToLoadmap["\N\NGERM FILE MAP\N\N"];
        FOR i: CARDINAL IN [0..segs.length) DO
            WITH segs[i] SELECT FROM
                s: MBVM.DataSeg => WriteGermData[s, relocationPages];
                s: MBVM.CodeSeg => WriteGermCode[s, relocationPages];
                s: MBVM.FileSeg => ERROR;
                ENDCASE;
            ENDLOOP;
        data.loadmap.PutF["\N\NGerm file pages: %n\N", IO.card[germPages]];
        };

    WriteGermData: PROC [seg: MBVM.DataSeg, relocationPages: CARDINAL] = {
        v: PrincOps.PageValue _ MapValueForSeg[seg];
        BootloadedSegToLoadmap[seg, filePage, v.state.flags, relocationPages];
        FOR page: CARDINAL IN [seg.base..seg.base+seg.pages) DO
            lp: LONG POINTER = MBVM.GetPage[page];
            IF lp = NIL THEN WriteEmptyPage[] ELSE WritePage[lp];
            ENDLOOP;
        };

    WriteGermCode: PROC [seg: MBVM.CodeSeg, relocationPages: CARDINAL] = {
        <<RRA fix: January 23, 1984 7:01:28 pm PST>>
        v: PrincOps.PageValue _ MapValueForSeg[seg];
        base: LONG POINTER = OpenSegForTransfer[seg];
        BootloadedSegToLoadmap[seg, filePage, v.state.flags, relocationPages];
        [] _ WriteCodeWords[base, 0, seg.pages*wordsPerPage, seg.pieces];
        filePage _ filePage + seg.pages;
        CloseSegAfterTransfer[seg, base];
        };

    <<Output Subroutines>>

    MapValueForSeg: PROC [seg: MBVM.Seg] RETURNS [PrincOps.PageValue] = {
        flags: PrincOps.PageFlags _ 
            IF ~seg.info.readOnly THEN PrincOps.flagsClean ELSE PrincOps.flagsReadOnly;
        <<reserved = FALSE (0) on a D0 means don't log single bit memory error>>
        RETURN[PrincOps.PageValue[BootFile.PageStateFromFlags[flags], 0]]
        };

    EnterPage: PROC [page: MBVM.Base, value: PrincOps.PageValue] = {
        IF currentEntry = nEntries THEN AddTrailerPage[];
        IF nEntries = BootFile.maxEntriesPerTrailer THEN
            trailer.entries[currentEntry] _ [page: page, value: value]
        ELSE header.entries[currentEntry] _ [page: page, value: value];
        currentEntry _ currentEntry + 1;
        };

    AddTrailerPage: PROC = {
        stream: IO.STREAM = data.bootStream;
        IF trailer ~= NIL THEN trailerIndex _ WriteTrailerPage[]
        ELSE {
            <<create trailer page>>
            TRUSTED {trailer _ LOOPHOLE[NEW[PageOfWords]]};
            trailerIndex _ stream.GetIndex[];
            };
        stream.SetLength[trailerIndex+bytesPerPage];
        stream.SetIndex[trailerIndex+bytesPerPage];
        TRUSTED {PrincOpsUtils.LongZero[LOOPHOLE[trailer], wordsPerPage]};
        trailer.version _ BootFile.currentVersion;
        nEntries _ BootFile.maxEntriesPerTrailer;
        currentEntry _ 0;
        data.loadmap.PutF["%6n  Trailer Page\N", IO.card[filePage]];
        filePage _ filePage + 1;
        };

    WriteTrailerPage: PROC RETURNS [index: INT] = {
        stream: IO.STREAM = data.bootStream;
        index _ stream.GetIndex[];
        stream.SetIndex[trailerIndex];
        stream.UnsafePutBlock[
            block: [base: LOOPHOLE[trailer], startIndex: 0, count: bytesPerPage]];
        stream.SetIndex[index];
        };

    WritePage: PROC [p: LONG POINTER] = {
        filePage _ filePage + 1;
        data.bootStream.UnsafePutBlock[block: [base: LOOPHOLE[p], startIndex: 0, count: bytesPerPage]];
        };

    WriteEmptyPage: PROC = {
        filePage _ filePage + 1;
        THROUGH [0..bytesPerPage) DO data.bootStream.PutChar['\000]; ENDLOOP;
        };

    OpenSegForTransfer: PROC [seg: MBVM.Seg] RETURNS [base: LONG POINTER] = {
        interval: VM.Interval = VM.Allocate[seg.pages];
        fileBase: MBVM.FileBase;
        file: FS.OpenFile;
        [file, fileBase] _ MBVM.BackingForSeg[seg];
        TRUSTED {
            base _ VM.AddressForPageNumber[interval.page];
            file.Read[from: fileBase, nPages: seg.pages, to: base];
            };
        file.Close[];
        };

    CloseSegAfterTransfer: PROC [seg: MBVM.Seg, base: LONG POINTER] = {
        TRUSTED {VM.Free[[VM.PageNumberForAddress[base], seg.pages]]};  
        };

    WriteCodeWords: PROC [
        base: LONG POINTER, offset: CARDINAL, count: CARDINAL, pieceList: MBVM.CodePieceList]
        RETURNS [MBVM.CodePieceList] = {
        pieceOffset, pieceLength: CARDINAL;
        stuff: LONG POINTER;
        DO
            pieceOffset _ pieceList.first.offset;
            TRUSTED {
                WITH p: pieceList.first SELECT FROM
                    code => {pieceLength _ p.length; stuff _ base + pieceOffset};
                    link => {
                        pieceLength _ p.links.length;
                        <<The following crock is necessary to avoid a bounds fault if `pieceLength' is zero, even though we wil never dereference `stuff' 
                        in this case!>>
                        IF pieceLength ~= 0 THEN stuff _ @p.links[0];
                        };
                    ENDCASE => ERROR;
                };
            IF offset IN [pieceOffset..pieceOffset + pieceLength) THEN {
                offsetInPiece: CARDINAL = offset - pieceOffset;
                nWords: CARDINAL = MIN[count, pieceLength - offsetInPiece];
                TRUSTED {
                    data.bootStream.UnsafePutBlock[
                        [base: stuff, startIndex: offsetInPiece*bytesPerWord, count: nWords*bytesPerWord]];
                    };
                offset _ offset + nWords;
                count _ count - nWords;
                };
            IF count = 0 THEN RETURN[pieceList];
            IF (pieceList _ pieceList.rest) = NIL THEN ERROR;
            ENDLOOP;
        };

    <<Loadmap Subroutines>>
    <<>>
    BootloadedHeadingToLoadmap: PROC [r: Rope.ROPE] = {
        loadmap: IO.STREAM = data.loadmap;
        loadmap.PutRope[r];
        loadmap.PutRope[" File      VM     Pages   Map    Type   Source[base,pages]\N"];
        loadmap.PutRope[" Page    Address (*=Pin) Flags\N"];
        };

    BootloadedSegToLoadmap: PROC [
        seg: MBVM.Seg, filePage: MBVM.Base, flags: PrincOps.PageFlags, relocation: CARDINAL _ 0] = TRUSTED {
        loadmap: IO.STREAM = data.loadmap;
        BootloadedCommonToLoadmap[
            filePage, seg.base.LONG + relocation, seg.pages, flags,
            data.germ OR (data.scriptBase[seg.index].info.state = resident), seg];
        loadmap.PutChar[Ascii.CR];
        };

    BootloadedSwapUnitToLoadmap: PROC [
        index: BootStartList.SwapUnitIndex, filePage: MBVM.Base, flags: PrincOps.PageFlags, seg: MBVM.Seg] = TRUSTED {
        loadmap: IO.STREAM = data.loadmap;
        su: LONG POINTER TO swapUnit BootStartList.Entry = @data.scriptBase[index];
        BootloadedCommonToLoadmap[
            filePage, data.scriptBase[su.parent].vmPage + su.base, su.pages, flags,
            su.info.state = resident, seg];
        loadmap.PutF["[%n,%n]", IO.card[su.base], IO.card[su.pages]];
        IF data.debug THEN
            loadmap.PutF["  SwapUnit[%n]", IO.card[LOOPHOLE[index, CARDINAL].LONG]];
        loadmap.PutChar[Ascii.CR];
        };

    BootloadedCommonToLoadmap: PROC [
        filePage: MBVM.Base, vmPage: PrincOps.PageNumber, pages: CARDINAL,
        flags: PrincOps.PageFlags,
        resident: BOOL, seg: MBVM.Seg] = {
        loadmap: IO.STREAM = data.loadmap;
        loadmap.PutF["%6n  %8n   %4n%g",
            IO.card[filePage],
            IO.card[vmPage*wordsPerPage],
            IO.card[pages],
            IO.rope[IF resident THEN "*" ELSE " "]
            ];
        loadmap.PutF["  %g%g%g    ",
            IO.rope[IF flags.readonly THEN "W" ELSE " "],
            IO.rope[IF flags.dirty THEN "D" ELSE " "],
            IO.rope[IF flags.referenced THEN "R" ELSE " "]
            ];
        SegmentSourceToLoadmap[seg];
        };

    NonBootloadedHeadingToLoadmap: PROC [r: Rope.ROPE] = {
        loadmap: IO.STREAM = data.loadmap;
        loadmap.PutRope[r];
        loadmap.PutRope[" File      VM     Pages          Type   Source[base,pages]\N"];
        loadmap.PutRope[" Page    Address\N"];
        };

    SegToLoadmap: PROC [seg: MBVM.Seg, backingPage: MBVM.Base] = TRUSTED {
        CommonToLoadmap[backingPage, seg.base.LONG, seg.pages, seg];
        data.loadmap.PutChar[Ascii.CR];
        };

    SwapUnitToLoadmap: PROC [
        index: BootStartList.SwapUnitIndex, backingPage: MBVM.Base, seg: MBVM.Seg] = TRUSTED {
        loadmap: IO.STREAM = data.loadmap;
        su: LONG POINTER TO swapUnit BootStartList.Entry = @data.scriptBase[index];
        CommonToLoadmap[
            backingPage, data.scriptBase[su.parent].vmPage + su.base, su.pages, seg];
        loadmap.PutF["[%n,%n]", IO.card[su.base], IO.card[su.pages]];
        IF data.debug THEN
            loadmap.PutF["  SwapUnit[%n]", IO.card[LOOPHOLE[index, CARDINAL].LONG]];
        loadmap.PutChar[Ascii.CR];
        };

    CommonToLoadmap: PROC [
        filePage: MBVM.Base, vmPage: PrincOps.PageNumber, pages: CARDINAL, seg: MBVM.Seg] = {
        data.loadmap.PutF["%6n  %8n   %4n          ",
            IO.card[filePage],
            IO.card[vmPage*wordsPerPage],
            IO.card[pages]
            ];
        SegmentSourceToLoadmap[seg];
        };

    SegmentSourceToLoadmap: PROC [seg: MBVM.Seg] = {
        loadmap: IO.STREAM = data.loadmap;
        WITH seg SELECT FROM
            s: MBVM.DataSeg => {loadmap.PutRope["data"]; RETURN};
            s: MBVM.CodeSeg => loadmap.PutRope["code   "];
            s: MBVM.FileSeg => loadmap.PutRope["file   "];
            ENDCASE;
        data.loadmap.PutF["%f[%n,%n]", IO.rope[seg.file], IO.card[seg.fileBase], IO.card[seg.pages]];
        };

    <<Ether Boot/Germ Output>>
    <<>>
    MakeEtherFile: PROC = {
        inStream, outStream: IO.STREAM _ NIL;
        bufferPages: CARDINAL = 50;
        PutEtherHeader: PROC [stream: IO.STREAM] = {
            etherHeader: EtherHeader _ [createTime: MesaToBCPLTime[data.buildTime]];
            length: CARDINAL = data.output.Length[];
            s: StringBody _ [
                length: length,
                maxlength: ((length+bytesPerWord-1)/bytesPerWord)*bytesPerWord,
                text: 
                ];
            TRUSTED {
                stream.UnsafePutBlock[
                    [base: LOOPHOLE[LONG[@etherHeader]],
                    startIndex: 0, count: bytesPerWord*SIZE[EtherHeader]]];
                };
            stream.PutRope[data.output];
            TRUSTED {
                stream.UnsafePutBlock[
                    [base: LOOPHOLE[LONG[@s]], startIndex: 0, count: bytesPerWord*SIZE[StringBody[0]]]];
                };
            THROUGH [bytesPerWord*(SIZE[EtherHeader]+SIZE[StringBody[0]])+length..bytesPerPage) DO
                stream.PutChar['\000];
                ENDLOOP;
            };
        MesaToBCPLTime: PROC [gmt: BasicTime.GMT] RETURNS [BCPLTime] = INLINE {
            ln: Basics.LongNumber;
            ln.lc _ BasicTime.ToPupTime[gmt];
            RETURN [[high: ln.highbits, low: ln.lowbits]]
            };
        data.typescript.PutF["Writing ether %y file...", IO.bool[data.germ]];
        {ENABLE UNWIND => {
            IF inStream ~= NIL THEN inStream.Close[];
            IF outStream ~= NIL THEN outStream.Close[];
            };
            inStream _ FS.StreamOpen[data.output];
            outStream _ FS.StreamOpen[
                fileName: data.etherOutput,
                accessOptions: $create,
                createByteCount: inStream.GetLength[] + bytesPerPage
                ];
            PutEtherHeader[outStream];
            IOClasses.Copy[
                from: inStream, to: outStream,
                closeFrom: TRUE, closeTo: TRUE,
                bufferByteCount: bufferPages*bytesPerPage
                ];
            };
        data.typescript.PutRope["finished writing.\N"];
        };

    END.