
    <<TestSparcLoader.Mesa>>
        <<Copyright Ó 1988 by Xerox Corporation.  All rights reserved.>>
        <<Bill Jackson (bj) August 5, 1988 3:47:02 pm PDT>>
        <<>>
    DIRECTORY
        FS USING [ StreamOpen ],
        IO USING [ Close, GetIndex, PutBlock, PutF, rope, SetIndex, STREAM, UnsafePutBlock ],
        Rope USING [ ROPE ],
        SimpleLoader,
        SparcLoader USING [ AllocateProc, Load, PokeProc, TargetAddress, UndefinedSymbol ],
        SunADotOut USING [ Module, ModuleFromFile, ModuleObject, WriteModule ],
        SunADotOutPrivate USING [ ModuleObject ];

    TestSparcLoader: CEDAR MONITOR
        IMPORTS FS, IO, SparcLoader, SunADotOut
        EXPORTS SimpleLoader, SunADotOut ~ {
        OPEN SparcLoader, SimpleLoader;
        ROPE: TYPE ~ Rope.ROPE;
    <<SimpleLoader>>
        Card16ArrayPtr: TYPE ~ LONG POINTER TO
        RECORD [SEQUENCE COMPUTED CARD16 OF CARD16];

        ODD: PROC [ i: INT32 ] RETURNS [ b: BOOL _ FALSE ] ~ INLINE
        { b _ ( i MOD 1 ) # 0 };

        SimpleLoader: PUBLIC PROC [ fname: ROPE _ NIL, putCard16: PutCard16Proc ] ~ {
            vmTarget: TargetAddress _ [bufSiz];
            SimpleAllocate: AllocateProc ~ {
                nextAddress: TargetAddress ~ [vmTarget + segment.block.count];
                nextPageBoundary: TargetAddress ~ [RoundUpBytes[vmTarget]];
                nextWithRoundup: TargetAddress ~ [nextPageBoundary + segment.block.count];
                SELECT flavor FROM
                    $text => { address _ vmTarget; vmTarget _ nextAddress };
                    $data => { address _ nextPageBoundary; vmTarget _ nextWithRoundup };
                    $bss => { address _ vmTarget; vmTarget _ nextAddress };
                    ENDCASE => { ERROR };
                };
            ZeroFill: PROC [ oldPos: CARD32, newPos: CARD32 ] ~ {
                diff: CARD32 ~ newPos - oldPos; -- can't/shouldn't ever be negative!
                };
            pos: CARD32 _ 0;
            SimplePoke: PokeProc ~ {
                wordAddrBase: INT32 ~ address / 2;
                firstWord: INT32 ~ block.startIndex / 2;
                lastWord: INT32 ~ ( block.startIndex + block.count ) / 2;
                SELECT TRUE FROM
                    ( ODD[address] ) => { ERROR };
                    ( ODD[block.startIndex] ) => { ERROR };
                    ( ODD[block.startIndex + block.count] ) => { ERROR };
                    ( pos = address ) => { NULL };
                    ( pos < address ) => { ZeroFill[pos, address] };
                    ENDCASE => { ERROR };
                FOR i: INT32 IN [firstWord .. lastWord) DO
                    TRUSTED { putCard16[wordAddrBase + i, LOOPHOLE[block.base, Card16ArrayPtr][i]] };
                    pos _ ( wordAddrBase + i ) * 2;
                    ENDLOOP;
                };
            out: IO.STREAM ~ FS.StreamOpen["SparcLoader.log", $create];
            test: Module ~ SunADotOut.ModuleFromFile[fname];
            SparcLoader.Load[test, SimpleAllocate, SimplePoke, bufSiz ! UndefinedSymbol =>
                { out.PutF[" undefined symbol: \"%g\"\n", IO.rope[info.symbol.text]]; RESUME[NIL] } ];
            out.Close[];
            };

    <<Debugging and Test routines>>
        rawHdrSiz: NAT ~ 32; -- BYTES[HdrObj];

        test: Module;
        code: IO.STREAM;
        lowcore: TargetAddress _ [rawHdrSiz]; -- magic for a.out header!

        zeroBuf: REF TEXT ~ NEW[TEXT[bufSiz]];
        ZeroFill: PROC [ code: IO.STREAM, oldPos: CARD32, newPos: CARD32 ] ~ {
            <<code.SetLength[newPos]; code.SetIndex[newPos] - should this be enough?>>
            diff: CARD32 ~ newPos - oldPos; -- can't/shouldn't ever be negative!
            code.PutBlock[zeroBuf, 0, diff];
            IF ( CARD32[code.GetIndex[]] # newPos ) THEN ERROR; -- huh?
            };

        ChunksForBytes: PROC [ bytes: CARD32 ] RETURNS [ chunks: CARD32 ] ~
        INLINE { chunks _ ( bytes + bufSiz.PRED ) / bufSiz };
        BytesForChunks: PROC [ chunks: CARD32 ] RETURNS [ bytes: CARD32 ] ~
        INLINE { bytes _ chunks * bufSiz };
        RoundUpBytes: PROC [ rough: CARD32 ] RETURNS [ even: CARD32 ] ~
        INLINE { even _ BytesForChunks[ChunksForBytes[rough]] };

        DummyAllocate: AllocateProc ~ {
            nextAddress: TargetAddress ~ [lowcore + segment.block.count];
            nextPageBoundary: TargetAddress ~ [RoundUpBytes[lowcore]];
            nextWithRoundup: TargetAddress ~ [nextPageBoundary + segment.block.count];
            SELECT flavor FROM
                $text => { address _ lowcore; lowcore _ nextAddress };
                $data => { address _ nextPageBoundary; lowcore _ nextWithRoundup };
                $bss => { address _ lowcore; lowcore _ nextAddress };
                ENDCASE => { ERROR };
            };

        DummyPoke: PokeProc ~ {
            pos: CARD32 ~ code.GetIndex[];
            SELECT TRUE FROM
                ( pos = address ) => { NULL };
                ( pos < address ) => { ZeroFill[code, pos, address] };
                ENDCASE => { ERROR };
            code.UnsafePutBlock[block];
            };

        Module: TYPE ~ REF ModuleObject;
        ModuleObject: PUBLIC TYPE ~ SunADotOutPrivate.ModuleObject;

        FixUpHdr: PROC [ code: IO.STREAM, m: Module ] ~ {
            pos: INT ~ code.GetIndex[];
            m.header.dynamic _ TRUE; -- just for now!
            m.header.magic _ ZMAGIC;
            m.header.text _ RoundUpBytes[m.header.text + rawHdrSiz];
            m.header.data _ RoundUpBytes[m.header.data + m.header.bss];
            m.header.bss _ 0;
            m.header.symbolTableSize _ 0;
            m.header.entryPoint _ rawHdrSiz; -- just for now!
            m.header.textRelocationSize _ 0;
            m.header.dataRelocationSize _ 0;
            m.header.stringTableSize _ 0;
            code.SetIndex[0];
            SunADotOut.WriteModule[code, m];
            code.SetIndex[pos];
            ZeroFill[code, pos, RoundUpBytes[pos]];
            <<code.SetLength[RoundUpBytes[pos]];>>
            };

        bufSiz: NAT ~ 8192;
        TestLoader: PROC [ fname: ROPE _ NIL ] ~ {
            out: IO.STREAM ~ FS.StreamOpen["SparcLoader.log", $create];
            code _ FS.StreamOpen["CodeImage.bin", $create];
            test _ SunADotOut.ModuleFromFile[fname];
            lowcore _ [rawHdrSiz]; -- magic for a.out header!
            SparcLoader.Load[test, DummyAllocate, DummyPoke, bufSiz ! UndefinedSymbol =>
                { out.PutF[" undefined symbol: \"%g\"\n", IO.rope[info.symbol.text]]; RESUME[NIL] } ];
            FixUpHdr[code, test];
            code.Close[];
            out.Close[];
            };

        }.