
    <<UncountedAssignHackImpl.mesa>>
        <<Copyright © 1986 by Xerox Corporation.  All rights reserved.>>
        <<Russ Atkinson (RRA) May 1, 1986 6:04:36 pm PDT>>
        <<McCreight, May 7, 1986 6:50:01 pm PDT>>

        DIRECTORY
            Allocator USING [BlockSizeIndex, bsiEscape, NHeaderP, NormalHeader],
            AllocatorOps USING [bsiToSize, NewObject, REFToNHP],
            Basics USING [RawWords],
            Commander USING [Register, CommandProc],
            PrincOpsUtils USING [LongCopy],
            RCMap USING [nullIndex],
            RTTypesBasicPrivate USING [MapTiTd],
            SafeStorage USING [Type],
            UncountedAssignHack;

    UncountedAssignHackImpl: CEDAR PROGRAM
        IMPORTS AllocatorOps, Commander, PrincOpsUtils, RTTypesBasicPrivate
        EXPORTS UncountedAssignHack
        = BEGIN OPEN UncountedAssignHack;

    UncountedSmallAssignProc: PUBLIC PROC [dst: REF, src: REF] RETURNS [AssignResult] = {
        SELECT TRUE FROM
            dst = NIL, src = NIL => RETURN [problem];
            dst # src => TRUSTED {
                dstNhp: Allocator.NHeaderP = AllocatorOps.REFToNHP[dst];
                dstType: SafeStorage.Type = dstNhp.type;
                dstBsi: Allocator.BlockSizeIndex = dstNhp.blockSizeIndex;
                srcNhp: Allocator.NHeaderP = AllocatorOps.REFToNHP[src];
                srcType: SafeStorage.Type = srcNhp.type;
                srcBsi: Allocator.BlockSizeIndex = srcNhp.blockSizeIndex;
                words: CARDINAL = AllocatorOps.bsiToSize[srcBsi];
                SELECT TRUE FROM
                    dstType # srcType => RETURN [typesNE];
                    dstBsi # srcBsi => RETURN [sizesNE];
                    RTTypesBasicPrivate.MapTiTd[dstType].rcmx # RCMap.nullIndex =>
                    RETURN [problem];
                    dstBsi = Allocator.bsiEscape => RETURN [problem];
                    words <= SIZE[Allocator.NormalHeader] => RETURN [problem];
                    ENDCASE;
                PrincOpsUtils.LongCopy[
                from: LOOPHOLE[src, LONG POINTER],
                nwords: words - SIZE[Allocator.NormalHeader],
                to: LOOPHOLE[dst, LONG POINTER]];
                };
            ENDCASE;
        RETURN [success];
        };

    UncountedSmallAssignPlease: PUBLIC PROC [dst: REF, src: REF] = {
        IF UncountedSmallAssignProc[dst, src] # success THEN ERROR;
        };

    UncountedSmallNewProc: PUBLIC PROC [src: REF] RETURNS [dst: REF _ NIL] = {
        <<Returns NIL if there was some problem.>>
        IF src # NIL THEN TRUSTED {
            srcNhp: Allocator.NHeaderP = AllocatorOps.REFToNHP[src];
            srcType: SafeStorage.Type = srcNhp.type;
            srcBsi: Allocator.BlockSizeIndex = srcNhp.blockSizeIndex;
            words: CARDINAL _ AllocatorOps.bsiToSize[srcBsi];
            IF words > SIZE[Allocator.NormalHeader] AND srcBsi # Allocator.bsiEscape AND RTTypesBasicPrivate.MapTiTd[srcType].rcmx = 
            RCMap.nullIndex THEN {
                words _ words - SIZE[Allocator.NormalHeader];
                dst _ AllocatorOps.NewObject[srcType, words];
                PrincOpsUtils.LongCopy[
                from: LOOPHOLE[src, LONG POINTER],
                nwords: words,
                to: LOOPHOLE[dst, LONG POINTER]];
                };
            };
        };


    UncountedSmallEqualProc: PUBLIC PROC [ref1, ref2: REF] RETURNS [EqualResult] = {
        SELECT TRUE FROM
            ref1 = NIL, ref2 = NIL => RETURN [problem];
            ref1 # ref2 => TRUSTED {
                nhp1: Allocator.NHeaderP = AllocatorOps.REFToNHP[ref1];
                type1: SafeStorage.Type = nhp1.type;
                bsi1: Allocator.BlockSizeIndex = nhp1.blockSizeIndex;
                nhp2: Allocator.NHeaderP = AllocatorOps.REFToNHP[ref2];
                type2: SafeStorage.Type = nhp2.type;
                bsi2: Allocator.BlockSizeIndex = nhp2.blockSizeIndex;
                words: CARDINAL = AllocatorOps.bsiToSize[bsi1];
                SELECT TRUE FROM
                    type1 # type2 => RETURN [typesNE];
                    bsi1 # bsi2 => RETURN [sizesNE];
                    bsi1 = Allocator.bsiEscape, bsi2 = Allocator.bsiEscape => RETURN [problem];
                    words <= SIZE[Allocator.NormalHeader] => RETURN [problem];
                    ENDCASE;
                FOR i: NAT IN [0..words-SIZE[Allocator.NormalHeader]) DO
                    IF LOOPHOLE[ref1, LONG POINTER TO Basics.RawWords][i]
                    # LOOPHOLE[ref2, LONG POINTER TO Basics.RawWords][i] THEN
                        RETURN [contentsNE];
                    ENDLOOP;
                };
            ENDCASE;
        RETURN [equal];
        };

    DiagnoseProblemProc: PUBLIC PROC [ref: REF] RETURNS [ProblemKind] = {
        IF ref # NIL THEN TRUSTED {
            refNhp: Allocator.NHeaderP = AllocatorOps.REFToNHP[ref];
            refType: SafeStorage.Type = refNhp.type;
            refBsi: Allocator.BlockSizeIndex = refNhp.blockSizeIndex;
            words: CARDINAL = AllocatorOps.bsiToSize[refBsi];
            SELECT TRUE FROM
                RTTypesBasicPrivate.MapTiTd[refType].rcmx # RCMap.nullIndex =>
                RETURN [typeIsRC];
                refBsi = Allocator.bsiEscape => RETURN [tooLong];
                words <= SIZE[Allocator.NormalHeader] => RETURN [tooShort];
                ENDCASE => RETURN [noProblem];
            };
        RETURN [nilRef];
        };

    Init: Commander.CommandProc = {NULL};

    Commander.Register["UncountedAssignHack", Init];

    END.